Quellcode-Bibliothek

unit PreProcessing;
interface
uses
  //----------------------------------------------------------------------------
  //local
  //----------------------------------------------------------------------------
  OwnUtils,GenDefs,Utilities,Splash,OptionClass,Lizenz,language,
  //----------------------------------------------------------------------------
  //global
  //----------------------------------------------------------------------------
  windows,sysutils,forms,dateutils;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
const
  //smax=20;
  em=13000;
  //----------------------------------------------------------------------------
  //Types
  //----------------------------------------------------------------------------
type
  Tffblk= record
    ff_reserved:integer;
    ff_fsize:integer;//file size
    ff_attrib:word;//attribute found
    ff_ftime:byte;//file time
    ff_fdate:byte;//file date
    ff_name: array [0..255] of char;//found file name
  end;
  cast= record
    case boolean of
      true:
        (tp:^Tffblk);
      false:
        (ti:integer);
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
var
  Mutex:THandle;
  ll1,ll2,i:integer;
  MyDir,DI,PS:String;
  MS:TMemoryStatus;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
procedure GetContext();
procedure PostProcess();
procedure PreProcess(Frame_title:String);
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
implementation
{ ------------------------------------------------------------------ }
{ -                                                                - }
{ -   Main Program                                                 - }
{ -                                                                - }
{ ------------------------------------------------------------------ }
procedure PreProcess(Frame_title:String);
var
  CDI:JString;
  HelpName:JString;
  Preprocessed:boolean;
begin
  Preprocessed:=false;
  Application.Title:=Frame_title;
  ColumboFileName:=Application.Title+'.exe';
  //
  SplashForm1:=TSplashForm.Create(nil);
  with splashform1 do
  if Application.title=Title_Elbe then
     image1.BringToFront
  else if lang=german then
    image2.BringToFront
  else
    image3.BringToFront;
  // get options and check parity
  GetContext();
  Lizenz1:=TLizenzForm.Create(nil);
  Opt:=TOptionDialog.create(nil);
  Lizenz1.checklicensesum();
  Opt.Hide();
  Opt.PostCheck();
  //------------------------------------------------
  //memory tracking
  //------------------------------------------------
  GlobalMemoryStatus(MS);
  InitiallyAvail:=MS.dwAvailPhys;
  //------------------------------------------------
  //get Options    U3 Stick?
  //------------------------------------------------
  DiskType:=getDiskType(opt.R.ProgramDir);
  MyDir:=getCurrentDir+'\'+ExtractFileName(Optionsfilename(Application.Title));
  if DiskType=DRIVE_REMOVABLE then
    ExitProcess(99);
  //
  if (DiskType=DRIVE_REMOTE)and not(opt.R.privileged='J') then begin
    errorn(132,'dies ist keine Netzwerklizenz');
    ExitProcess(0);
  end
  else if (DiskType=DRIVE_REMOVABLE) then begin
    errorn(159,'dies ist keine tragbare Lizenz');
    ExitProcess(0);
  end;
  //set program dir
  DI:=getCurrentDir+'\';
  CDI:=opt.R.ProgramDir;
  if LowerCase(String(DI))<>LowerCase(CDI) then begin
    DI:=String(opt.R.ProgramDir);
    SetCurrentDirectory(PChar(DI));
  end;
  GetContext();
  Opt.setDaysUsed(Installkey,Opt.R.SecretKey,Productnumber);
  //
  if Application.Title=Title_Elbe then
    opt.R.Edition:=Standard;
  Mutex:=CreateMutex(nil,true,PWChar(Application.Title));
  if (Mutex=0)OR(GetLastError=ERROR_ALREADY_EXISTS) then
    errorn(133,Application.Title+' läuft bereits')
  else if (DiskType=DRIVE_REMOTE)and not(opt.R.privileged='J') then begin
    errorn(134,'dies ist keine Netzwerklizenz');
    ExitProcess(0);
  end
  else
    Preprocessed:=true;
  Opening:=true;
  if opt.R.language=german then
    HelpName:='standard.deutsch.chm'
  else
    HelpName:='standard.english.chm';
  Application.HelpFile:=String(opt.R.ProgramDir)+HelpName;
  if not FileExists(Application.HelpFile) then
    errorn(135,'Hilfedatei fehlt');
  if not Preprocessed then
    ExitProcess(0);
end;
procedure PostProcess();
begin
  //------------------------------------------------
  //Put Options
  //------------------------------------------------
  //opt.R.DaysUsed:=6;   //for testing
  //Opt.R.FirstUse:=StrToDate('01.08.2010');
  //------------------------------------------------
  opt.PutOptions(PChar(Optionsfilename(Application.Title)));
  ReleaseMutex(Mutex);
end;
//------------------------------------------------------------------------------
//
//get Context
//
//------------------------------------------------------------------------------
procedure GetContext();
const
  lines=22;
  columns=7;
  ext: array [0..lines,1..columns] of String=(
    //ext name format exe  filename lex,pretty,back,meas,CFA,DFA,Func
    //--------------------------------------------------------------------------
    ('*.abap','Abap','Free','0','Abap','L','0'),
    ('*.acc;*.yacc;*.y','Accent','Free','0','Accent','L','0'),
    ('*.adb;*.ads','Ada','Free','0','Ada','L','0'),
    ('*.cob;*.cbl;*.cpy;*','Cobol','Fixed','0','Cobol','S','0'),
    ('*.c;*.cpp;*.h','C','Free','0','C','L','0'),
    ('*.bat;*.cmd','Command','Free','1','Bat','L','0'),
    ('*.pas;*.dfm;*.inc','Delphi','Free','0','Delphi','L','0'),
    ('*.ftn;*.ftn77;*.f90','Fortran','Free','0','Fortran','L','0'),
    ('*.in','GAP','Free','0','GAP','L','0'),
    ('*.asm','HLAsm','Fixed','0','HLASM','L','0'),
    ('*.java','JAVA','Free','0','Java','L','0'),
    ('*.jcl','Job Control','Fixed','0','JCL','L','0'),
    ('*.thy','Isabelle','Free','0','Isabelle','L','1'),
    ('*.lex','Lex','Free','0','Lex','L','0'),
    ('*.mt;*.mt940','MT940','Free','0','MT940','L','0'),
    ('*.pl','Perl','Free','0','Perl','L','0'),
    ('*.net','Petri Net','Free','0','Petri','S','1'),
    ('*.poe','SPS','Free','0','SPS','L','0'),
    ('*.txt','Text','Free','0','Text','L','0'),
    ('*.trs','TRS','Free','0','TRS','S','1'),
    ('*.rexx','REXX','Free','0','REXX','L','0'),
    ('*.vhdl','VHDL','Free','0','Vhdl','L','0'),
    ('*.xml','XML','Free','0','XML','L','0'));
var
  i,ll,li,le:integer;
  S:String;
  //restriction for Elbe
  procedure restrict(li:integer);
  begin
    if Application.Title=Title_Elbe then begin
        extensions[li].lexonly:=true
    end;
  end;
//get table entries
  procedure en(S1,S2,S3,S4,S5,S6,S7:string);
  begin
    if FileExists(S+S5+dlle) then begin
      extensions[li].ext:=S1;
      extensions[li].longname:=S2;
      extensions[li].format:=FreeFormat;
      if S3='Fixed' then
        extensions[li].format:=FixedFormat;
      extensions[li].isexecutable:=S4='1';
      extensions[li].dllname:=S5;
      extensions[li].lexonly:=S6='L';
      extensions[li].PrettyPrint:=S7='1';
      restrict(li);
      li:=li+1;
    end
  end;
begin
  S:=getCurrentDir+'\';
  ll:=0;
  le:=length(ext)-1;
  for i:=0 to le do
    if FileExists(S+ext[i,5]+dlle) then
      ll:=ll+1;
  setlength(AD,ll);
  setlength(ADhandle,ll);
  setlength(extensions,ll);
  for i:=0 to ll-1 do
    ADhandle[i]:=0;
  li:=0;
  for i:=0 to le do
    en(ext[i,1],ext[i,2],ext[i,3],ext[i,4],ext[i,5],ext[i,6],ext[i,7]);
end;
//----------------------------------------------------------------------------
//Static Variables
//----------------------------------------------------------------------------
end.

[ Original von:0.13Diese Quellcodebibliothek enthält Beispiele in vielen Programmiersprachen. Man kann per Verzeichnistruktur darin navigieren. Der Code wird farblich markiert angezeigt.  Datei übertragen  ]