Ziele Untersuchung
mit Columbo Integrität von
Datenbanken Interaktion und
Portierbarkeit Ergonomie der
Schnittstellen

Angebot Produkte Projekt Beratung

Mittel Analytik Modellierung Sprachen Algebra Logik Hardware Denken Kreativität

Zusammenhänge Gesellschaft Wirtschaft Branche Firma


products/sources/formale Sprachen/Delphi/Elbe 1.0/Sources/ (Columbo Version 0.7^©) Datei vom 16.10.2010 mit Größe 7 kB

Quelle PreProcessing.pas Sprache: Delphi

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.

quality93%

¤ Dauer der Verarbeitung: 0.15 Sekunden (vorverarbeitet) ¤

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.