SSL OwnUtils.old.pas  Sprache: unbekannt

unit OwnUtils;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
interface
uses
  //----------------------------------------------------------------------------
  //local
  //----------------------------------------------------------------------------
  GenDefs,mysql,Utilities,language,
  //----------------------------------------------------------------------------
  //global
  //----------------------------------------------------------------------------
  ComCtrls,ExtCtrls,Graphics,Forms,Types;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
const
{$I OwnConsts.inc}
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
type
{$I OwnTypes.inc}
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
function GetSecrets(Installkey:JString;SK:JString;ProductNumber:char):integer;
procedure SetSecrets(Installkey:JString;V:integer;ProductNumber:char);
Procedure DefaultOptions(var Opt:OwnOptions);
procedure setl(var a: array of char;S:JString);
function empty(P:PAnsiChar;V:ViewData):boolean;
function TreeHide(var TS:TTReeView):PLongTexts;
function InSight(var P:ViewData):boolean;
function Longeur(PL:PLongTexts;Tx:TTreeNode):JString;
procedure Statusline(PC:TPageControl;Opt:OwnOptions;var SB:TStatusBar;
  Tip:JString);
function dllcall(var Opt:OwnOptions;var Libraries:AnsiString;
  Path,Source:JString;var lexlang:integer;var CNav,CFA,DFA,CSem,CMes,
  CFun,Attr:PAnsiChar;var Coldef:integer;Edition:JString;
  var status:PAnsiChar;var dllinfo:PAnsiChar;var warnings:integer):integer;
function netallowed:boolean;
function MouseOver(Fr:Frames;Opt:OwnOptions):boolean;
function GetNextRec(TC:PAnsiChar):JString;
procedure OpenStream(TC:PAnsiChar);
//----------------------------------------------------------------------------
//Global Vars
//----------------------------------------------------------------------------
var
  MDI:Document;
  InitialMemory:longint;
  Lizenzmeldung:boolean;
  Opening,Closing:boolean;
  Loading,Splitting:boolean;
  Inspectorkey:JString;
  DiskDrive:JString;
  SourceInfo:JString24;
  DiskType:integer;
  Filters:JString;
  Dom: array [0..2] of char;
  ViewList: TFrameState;
  AD: array of AllDll;
  ADHandle: array of THandle;
  Extensions: array of LangType;
  Createbackup:boolean;
  netflag:boolean;
  Title:JString;
  ColumboFileName:JString;
  BatchRun,Recursive:boolean;
  PrettyPrint:boolean;
  ShowPrettyPrint:boolean;
  Im_Root,Im_Branch,Im_Level,Im_State,im_Error:integer;
  P6,P7:PChar;
  VerticeStack: array of integer;
  VerticeStp:integer;
  lev,lastlev,offs:integer;
  next,count:integer;
  eofs:boolean;
  LastMousePos:TPoint;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
implementation
uses
  //----------------------------------------------------------------------------
  //specific
  //----------------------------------------------------------------------------
  Messages,SysUtils,Variants,Classes,Controls,Dialogs,StdCtrls,jpeg,
  StrUtils,WinSock,Registry,ShellAPI,Math,DateUtils,Windows
{$I Indy.inc}
  ;
//------------------------------------------------------------------
//framestate
//
//------------------------------------------------------------------
constructor TFRameState.create();
var fr:Frames;
begin
  next:=nil;
  Previous:=nil;
  for FR:=F1 to F3 do
   st[FR].ActiveView:=NoView;
end;
//------------------------------------------------------------------
//test if net allowed
//
//------------------------------------------------------------------
function netallowed:boolean;
begin
  if not netflag then
    netflag:=ask(140,'In das Internet gehen?');
  result:=netflag
end;
//------------------------------------------------------------------
//Procedure Setl
//moving of short arrays
//------------------------------------------------------------------
procedure setl(var a: array of char;S:JString);
var
  i:integer;
begin
  for i:=0 to length(a)-1 do
    a[i]:=chr(0);
  i:=0;
  if length(S)>=sizeof(a) then
    errorn(101,'fataler Fehler')
  else
    while (i<length(S))and(i<sizeof(a)) do begin
      a[i]:=S[i+1];
      i:=i+1
    end;
end;
//-----------------------------------------------------------------
//function dllcall
//set Options.R.
//-----------------------------------------------------------------
function dllcall(var Opt:OwnOptions;var Libraries:AnsiString;
  Path,Source:JString;var lexlang:integer;var CNav,CFA,DFA,CSem,CMes,
  CFun,Attr:PAnsiChar;var Coldef:integer;Edition:JString;
  var status:PAnsiChar;var dllinfo:PAnsiChar;var warnings:integer):integer;
var
  rv:integer;
  ext:JString;
  Libs: array [0..2047] of char;
  PLibs:PAnsiChar;
  ret,lib:JString;
  i,hand:integer;
begin
  if length(Libraries)+length(Path)+length(Source)-8>=2048 then begin
    showmessage(trans(lang,52,'Lib zu lang'));
    ExitProcess(100);
  end;
  ret:=chr(Key_LineFeed);
  PLibs:=@Libs;
  StrCopy(PLibs,PAnsiChar(AnsiString(Source)+AnsiString(ret)+AnsiString(Path)
        +AnsiString(ret)+AnsiString(Libraries)));
  ext:=ExtractFileExt(Source);
  ext:=Lowercase(ext);
  //find right record
  hand:=-1;
  for i:=0 to length(Extensions)-1 do begin
    if pos(ext,Extensions[i].ext)>0 then
      hand:=i;
  end;
  rv:=99;
  if hand<0 then
    errorn(102,'falsche Extension der Datei')
  else
    try
      lib:=Opt.ProgramDir+Extensions[hand].dllname;
      if (ADHandle[hand]=0)and(Fileexists(lib)) then
        ADHandle[hand]:=LoadLibrary(PChar(lib));
      if ADHandle[hand]<>0 then begin
        @AD[hand]:=GetProcAddress(ADHandle[hand],
          PChar(Extensions[hand].entrypoint));
        rv:=AD[hand](PLibs,lexlang,CNav,CFA,DFA,CSem,CMes,CFun,Attr,Coldef,
          PAnsiChar(AnsiString(Edition)),status,dllinfo,warnings)
      end
      else begin
        errorn(103,'Bibliothek für '+Extensions[hand].dllname+
            '-Dateien nicht vorhanden');
        rv:=99;
      end
      except
        on E:Exception do begin
          errorn(104,E.Message);
          rv:=911;
        end
        else begin
          errorn(105,'Bibliothek für '+Extensions[hand].dllname+
              '-Dateien nicht vorhanden');
          rv:=99;
        end
      end;
      Libraries:=PLibs;
      dllcall:=rv;
    end;
  //----------------------------------------------------------------
  //Hide long texts in Tree
  //
  //----------------------------------------------------------------
  function TreeHide(var TS:TTReeView):PLongTexts;
  var
    T:PLongTexts;
    tt:TTreeNode;
    i:integer;
    MaxWidth:integer;
  begin
    new(T);
    SetLength(T^.items,TS.items.count);
    TS.items.BeginUpdate;
    tt:=TS.TopItem;
    i:=0;
    MaxWidth:=0;
    while not(tt=nil) do begin
      T^.items[i].Ptr:=tt;
      //catcher(i=321);
      setl(T^.items[i].Text,tt.Text);
      tt.Text:=Functor(tt.Text);
      tt.Text:=StringReplace(tt.Text,'\\','\',[rfReplaceAll]);
      tt.Text:=StringReplace(tt.Text,'\\','\',[rfReplaceAll]);
      if tt.Level<3 then
        MaxWidth:=max(length(tt.Text),MaxWidth);
      tt:=tt.GetNext;
      i:=i+1;
    end;
    TS.items.EndUpdate;
    TreeHide:=T;
  end;
  //----------------------------------------------------------------
  //get long text of Treenode
  //
  //----------------------------------------------------------------
  function Longeur(PL:PLongTexts;Tx:TTreeNode):JString;
  var
    i:integer;
    Tn:TTreeNode;
    ll:integer;
  begin
    Longeur:='';
    if PL<>nil then begin
      ll:=length(PL^.items)-1;
      for i:=0 to ll do begin
        Tn:=PL^.items[i].Ptr;
        if Tn=Tx then
          Longeur:=PL^.items[i].Text;
      end
    end;
  end;
  //-----------------------------------------------------------------
  //function setsecrets                                          -
  //-
  //-----------------------------------------------------------------
  procedure SetSecrets(Installkey:JString;V:integer;ProductNumber:char);
  begin
    if DiskType<>DRIVE_REMOVABLE then begin
      SetSecretRegistryValue(Installkey,V,AnsiChar(ProductNumber));
      SetSecretFile(Installkey,V,ProductNumber);
    end;
  end;
  //-----------------------------------------------------------------
  //function setsecrets                                          -
  //-
  //-----------------------------------------------------------------
  function GetSecrets(Installkey:JString;SK:JString;ProductNumber:char):integer;
  var
    r1,r2:integer;
  begin
    r2:=-1;
    if DiskType<>DRIVE_REMOVABLE then begin
      r1:=GetSecretRegistryValue(Installkey,ProductNumber);
      r2:=GetSecretFile(Installkey,SK,ProductNumber);
      if r1<>r2 then
        r2:=-1;
    end;
    GetSecrets:=r2
  end;
  //-----------------------------------------------------------------
  //DEefault input                                               -
  //-----------------------------------------------------------------
  function getdefaultfile():JString;
  var
    f:JString;
  begin
    f:=GetCurrentDir+'\'+'workspace\hallo.cbl';
    if not Fileexists(f) then
      f:=GetCurrentDir+'\'+'workspace\hallo.bat';
    getdefaultfile:=f;
  end;
  //-----------------------------------------------------------------
  //Create Tabsheet                                              -
  //-----------------------------------------------------------------
  function empty(P:PAnsiChar;V:ViewData):boolean;
  begin
    if P=nil then
      empty:=true
    else if length(P)=0 then
      empty:=true
    else if V.Sheet.PageControl=nil then
      empty:=true
    else
      empty:=false
  end;
  //-----------------------------------------------------------------
  //Tabsheet visible?                                            -
  //-----------------------------------------------------------------
  function InSight(var P:ViewData):boolean;
  begin
    if not(P.Frame in [F1..F3]) then
      InSight:=false
    else if P.Sheet=nil then
      InSight:=false
    else if not P.Sheet.visible then
      InSight:=false
    else if P.Sheet.PageControl=nil then
      InSight:=false
    else if P.Sheet.Width<10 then
      InSight:=false
    else if P.Sheet.Height<10 then
      InSight:=false
    else
      InSight:=P.Sheet=P.Sheet.PageControl.ActivePage;
  end;
  //------------------------------------------------------------------
  //--
  //get next Record in Streamn/String                            --
  //--
  //------------------------------------------------------------------
  function GetNextRec(TC:PAnsiChar):JString;
  var
    S:JString;
  begin
    next:=offs;
    lastlev:=lev;
    lev:=0;
    while (TC[next]=chr(9))and(next<=Length(TC)) do begin
      lev:=lev+1;
      next:=next+1;
    end;
    S:='';
    while (TC[next]>chr(15))and(next<=length(TC)) do begin
      S:=S+String(TC[next]);
      next:=next+1;
    end;
    eofs:=(TC=nil)or(TC='')or(TC[next]=chr(0))or(TC[next+1]=chr(0));
    offs:=next+1;
    count:=count+1;
    GetNextRec:=S;
  end;
  //------------------------------------------------------------------
  //--
  //open Stream/String                                           --
  //--
  //------------------------------------------------------------------
  procedure OpenStream(TC:PAnsiChar);
  begin
    offs:=0;
    eofs:=false;//Reset Stream
    count:=0;
    lev:=0;
    lastlev:=0;//Reset Tree
  end;
  //-----------------------------------------------------------------
  //Tabsheet visible?                                            -
  //-----------------------------------------------------------------
  function MouseOver(Fr:Frames;Opt:OwnOptions):boolean;
  var
    PC:TPageControl;
    f:TFrame;
    MF:TForm;
  begin
    PC:=nil;
    if Fr=Opt.Navigator.Frame then
      PC:=Opt.Navigator.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Semantik.Frame then
        PC:=Opt.Semantik.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Explorer.Frame then
        PC:=Opt.Explorer.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Source.Frame then
        PC:=Opt.Source.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.CFA.Frame then
        PC:=Opt.CFA.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.DFA.Frame then
        PC:=Opt.DFA.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Measures.Frame then
        PC:=Opt.Measures.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Funktion.Frame then
        PC:=Opt.Funktion.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Miniatur.Frame then
        PC:=Opt.Miniatur.Sheet.PageControl;
    if PC=nil then
      if Fr=Opt.Druckvorschau.Frame then
        PC:=Opt.Druckvorschau.Sheet.PageControl;
    f:=(PC.Parent as TFrame);
    MF:=(f.Parent as TForm);
    MouseOver:=(Mouse.CursorPos.x>=MF.left+f.left+PC.left)and
      (Mouse.CursorPos.x<=MF.left+f.left+PC.left+PC.Width)and
      (Mouse.CursorPos.y>=MF.top+f.top+PC.top)and
      (Mouse.CursorPos.y<=MF.top+f.top+PC.top+PC.Height)
  end;
  //-----------------------------------------------------------------
  //Tabsheet visible?                                            -
  //-----------------------------------------------------------------
  procedure Statusline(PC:TPageControl;Opt:OwnOptions;var SB:TStatusBar;
    Tip:JString);
  var
    vissheet:TTabSheet;
    Fr:Frames;
    st,M,SN,TD,S,SI:JString;
  begin
    SN:='';
    S:='';
    SI:='';
    Fr:=F1;
    vissheet:=PC.ActivePage;
    if Opt.language=english then begin
      if vissheet=Opt.Navigator.Sheet then
        SN:='Navigator'
      else if vissheet=Opt.Semantik.Sheet then
        SN:='Semantics'
      else if vissheet=Opt.Explorer.Sheet then
        SN:='Explorer'
      else if vissheet=Opt.Source.Sheet then
        SN:='Source'
      else if vissheet=Opt.CFA.Sheet then
        SN:='Cfa'
      else if vissheet=Opt.DFA.Sheet then
        SN:='Dfa'
      else if vissheet=Opt.Measures.Sheet then
        SN:='Measures'
      else if vissheet=Opt.Funktion.Sheet then
        SN:='Function'
      else if vissheet=Opt.Miniatur.Sheet then
        SN:='Miniatur'
      else if vissheet=Opt.Druckvorschau.Sheet then
        SN:='Printpreview';
    end
    else begin
      if vissheet=Opt.Navigator.Sheet then
        SN:='Navigator'
      else if vissheet=Opt.Semantik.Sheet then
        SN:='Semantik'
      else if vissheet=Opt.Explorer.Sheet then
        SN:='Explorer'
      else if vissheet=Opt.Source.Sheet then
        SN:='Quelle'
      else if vissheet=Opt.CFA.Sheet then
        SN:='Cfa'
      else if vissheet=Opt.DFA.Sheet then
        SN:='Dfa'
      else if vissheet=Opt.Measures.Sheet then
        SN:='Maße'
      else if vissheet=Opt.Funktion.Sheet then
        SN:='Funktion'
      else if vissheet=Opt.Miniatur.Sheet then
        SN:='Miniatur'
      else if vissheet=Opt.Druckvorschau.Sheet then
        SN:='Druckvorschau';
    end;
    if vissheet=Opt.Navigator.Sheet then
      Fr:=Opt.Navigator.Frame
    else if vissheet=Opt.Semantik.Sheet then
      Fr:=Opt.Semantik.Frame
    else if vissheet=Opt.Explorer.Sheet then
      Fr:=Opt.Explorer.Frame
    else if vissheet=Opt.Source.Sheet then
      Fr:=Opt.Source.Frame
    else if vissheet=Opt.CFA.Sheet then
      Fr:=Opt.CFA.Frame
    else if vissheet=Opt.DFA.Sheet then
      Fr:=Opt.DFA.Frame
    else if vissheet=Opt.Measures.Sheet then
      Fr:=Opt.Measures.Frame
    else if vissheet=Opt.Funktion.Sheet then
      Fr:=Opt.Funktion.Frame
    else if vissheet=Opt.Miniatur.Sheet then
      Fr:=Opt.Miniatur.Frame
    else if vissheet=Opt.Druckvorschau.Sheet then
      Fr:=Opt.Druckvorschau.Frame;
    if Opt.InspectorVisible and(Fr=F1) then
      SN:=SN+'+ Inspector';
    if Opt.Source.Sheet=vissheet then begin
      S:=SN+' '+ExtractFileName(Opt.Actfile)+' ';
      if st>'' then
        M:='['+st+']';
      S:=S+'  '+M;
      SI:=SourceInfo;
    end
    else begin
      if InSight(Opt.Source) then
        S:=S+M+TD
      else
        S:=S+TD;
      S:=SN+' '+ExtractFileName(Opt.Actfile);
    end;
    SB.SimpleText:=S+SI+' '+Tip;
  end;
  //-----------------------------------------------------------------
  //Procedure DefaultOptions                                         -
  //set Options                                                  -
  //-----------------------------------------------------------------
  Procedure DefaultOptions(var Opt:OwnOptions);
  var
    i:integer;
    FC:JString;
  begin
    for i:=0 to maxoptsize do
      Opt.cc[i]:=chr(0);
    setl(Opt.homeDir,ExtractFilePath(Optionsfilename(Title)));
    setl(Opt.ProgramDir,ExtractFilePath(ParamStr(0)));
    setl(Opt.RemoteDir,Opt.ProgramDir+RemoteDirectory);
    setl(Opt.ExecDir,Opt.ProgramDir+ExecDir);
    FC:=Opt.ProgramDir+'compilebatch.bat';
    if not Fileexists(FC) then
      FC:='';
    setl(Opt.CommandFile,FC);
    setl(Opt.ExportDir,GetCurrentDir);
    Opt.ExportEnabled:=false;
    //-----------------------------------------------------------------------------
    //Licensing  //
    //-----------------------------------------------------------------------------
    Opt.Activated:=false;
    Opt.FirstUse:=DateOf(Now);
    Opt.LastUse:=DateOf(Now);
    Opt.DaysEffectivlyUsed:=0;
    Opt.DaysUsed:=0;
    if DiskType<>DRIVE_REMOVABLE then
      setl(Opt.SecretKey,SetSecretRegistryValue(Installkey,0,ProductNumber));
    if (Title=Title_Columbo) then
      Opt.Edition:=Shareware
    else if (Title=Title_Elbe) then
      Opt.Edition:=Shareware;
    //
    Opt.inited:=' ';
    Opt.privileged:=' ';
    Opt.BackgroundColor:=clWhite;
    Opt.ButtonSize:=5;
    Opt.FontName:='Courier New';
    Opt.FontSize:=9;
    Opt.drawgrid:=false;
    if Screen.Width>(3*Screen.Height)div 2 then begin
      Opt.Width:=11*Screen.Width div 32;
      Opt.Height:=3*Screen.Height div 4;
    end
    else begin
      Opt.Width:=21*Screen.Width div 32;
      Opt.Height:=3*Screen.Height div 4;
    end;
    Opt.top:=(Screen.Height)div 8;
    Opt.left:=(Screen.Width div 2)-(Opt.Width div 2);
    Opt.ismax:=false;
    //DefaultFrames;
    Opt.frame1Page1Max:=false;
    Opt.frame1Page2Max:=false;
    Opt.frame2Page1Max:=false;
    Opt.Frame3Page1Max:=false;
    //source options
    Opt.SyntaxHighlight:=true;
    Opt.SyntaxBold:=false;
    Opt.ShowSpaces:=false;
    Opt.Columnumbers:=false;
    Opt.Linenumbers:=false;
    Opt.Blocknumbers:=false;
    Opt.Sourceformat:=FixedFormat;
    Opt.Highlites[H_keyword]:=clblue;
    Opt.Highlites[H_String]:=clred;
    Opt.Highlites[H_Numeric]:=clMaroon;
    Opt.Highlites[H_Identifier]:=clblack;
    Opt.Highlites[H_Foreignkeyword]:=clNavy;
    Opt.Highlites[H_Comment]:=clgreen;
    Opt.Highlites[H_Foreignidentifier]:=clgray;
    Opt.Highlites[H_Label]:=clPurple;
    Opt.Highlites[H_Lexelem]:=clFuchsia;
    Opt.Coldefine:=false;
    Opt.InternetAllowed:=false;
    //input files
    Opt.LastFilter:='.cob';
    setl(Opt.Libraries[1],Opt.ProgramDir+'workspace\'+CopyLib);
    for i:=2 to 3 do
      Opt.Libraries[i]:='';
    for i:=1 to HistMax do
      Opt.HistoryFile[i]:='';
    for i:=1 to HistMax do
      Opt.HistoryCount[i]:=0;
    for i:=1 to HistMax do
      Opt.HistoryDateTime[i]:=Now;
    for i:=1 to HistMax do begin
      Opt.HistoryPosition[i][F1].ActiveView:=ViewNav;
      Opt.HistoryPosition[i][F2].ActiveView:=ViewSource;
      Opt.HistoryPosition[i][F3].ActiveView:=NoView;
    end;
    for i:=1 to length(Opt.FillUp) do
      Opt.FillUp[i]:=Random;
    setl(Opt.Infile,getdefaultfile());
    Opt.Actfile:='';
    setl(Opt.WindowsProductId,GetWinProductId);
    Opt.FuncHelp:=Key_F1;
    Opt.FuncSearch:=Key_F3;
    Opt.FuncReplace:=Key_F4;
    Opt.FuncContReplace:=Key_F5;
    Opt.FuncHelp:=Key_F1;
    Opt.Frame1Width:=Opt.Width div 4;
    Opt.ThumbnailWidth:=Opt.Width div 4;
    Opt.Frame3Height:=Opt.Height div 3;
    Opt.InspectorHeight:=(Opt.Height-Borderwidth)div 3;
    Opt.InspectorVisible:=true;
    Opt.LineThickness:=1;
    Opt.EndofOpts:=true;
    Opt.Navigator.Frame:=F1;
    Opt.Semantik.Frame:=F1;
    Opt.Explorer.Frame:=F1;
    Opt.Source.Frame:=F2;
    Opt.CFA.Frame:=F2;
    Opt.DFA.Frame:=F2;
    Opt.Measures.Frame:=F2;
    Opt.Funktion.Frame:=F2;
    Opt.Miniatur.Frame:=F3;
    Opt.Druckvorschau.Frame:=F3;
    Opt.Createbackup:=false;
    Opt.language:=german;
    Opt.Timeout:=10;
    if Fileexists(Opt.ProgramDir+'english.txt') then
      Opt.language:=english;
    //now generate check sums
    if length(Extensions)>0 then begin
      Opt.CobolDllLen:=getFileLength(Extensions[1].dllname);
      Opt.CobolDllSum:=getFileSum(Extensions[1].dllname);
      Opt.ColumboLen:=getFileLength(ColumboFileName);
      Opt.ColumboSum:=getFileSum(ColumboFileName);
      Opt.ColumboDate:=getFileAge(ColumboFileName);
    end;
  end;
end.