|
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.
¤ Dauer der Verarbeitung: 0.5 Sekunden
(vorverarbeitet)
¤
|
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.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|
