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 5.0.2011 mit Größe 19 kB

Quelle OwnUtils.pas Sprache: Delphi

unit OwnUtils;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
interface
uses
  //----------------------------------------------------------------------------
  //local
  //----------------------------------------------------------------------------
  GenDefs,Utilities,language,splash,
  //----------------------------------------------------------------------------
  //global
  //----------------------------------------------------------------------------
  ComCtrls,ExtCtrls,Graphics,Forms,Types, Classes;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
const
{$I OwnConsts.inc}
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
type
{$I OwnTypes.inc}
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
  Frames=(F1,F2,F3);
  ViewType=(ViewNav,ViewSem,ViewExplorer,ViewSource,ViewCFA,ViewDFA,
    ViewMeasures,ViewFunktion,ViewMiniatur,ViewDruckvorschau,
    ViewExecution,NoView);
  ViewData= record
    Sheet:TTabSheet;
    Frame:Frames;
  end;
  FrameView= record
    ActiveView:ViewType;
    Fnr:integer;
    Node:integer;
    Pos:TPoint;
    Sellength:integer;
    width,height:integer;
    top,left:integer;
  end;
  Perspective= array [F1..F3] of FrameView;
  PrintTypes=(Richtext,Imageview);
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
  THistory= record
    FileName:JStringKeyMax;
    Count:Cardinal;
    DateTime:TDateTime;
    Per:Perspective;
  end;
  THistories= array [1..histmax] of THistory;
  //----------------------------------------------------------------------------
  //Longtexts of Trees
  //----------------------------------------------------------------------------
  LongText= record
    Ptr:TTReeNode;
    Text:JStringKeyMax;
  end;
  ExpLongRef= array of integer;
  PLongTexts=^LongTexts;
  LongTexts= record
    items: array of LongText;
    Selected:Pointer;
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
  OwnOptions= record
    case boolean of
      true:
         (OptionSum:LongInt;
          OptionLen:LongInt;
          ColumboLen:LongInt;
          ColumboSum:LongInt;
          ColumboDate:TDate;
          CobolDllLen:LongInt;
          CobolDllSum:LongInt;
          //must start here
          inited:char;
          NextCheck:TDate;
          privileged:char;
          ExportEnabled:boolean;
          WindowsProductId:JString24;
          CPU:JString24;
          DiskId:JString24;
          IPAddr:JString24;
          Ethernetaddr:JString24;
          language:Naturallanguages;
          BackgroundColor:TColor;
          ButtonColor:TColor;
          ButtonSize:integer;
          FontName:JString48;
          Font2Name:JString48;
          FontColor:TColor;
          FontStyle:TFontStyles;
          FontSize:integer;
          Infile:JStringKeyMax;
          SecretKey:JStringKeyMax;
          Highlites: array [Highlite] of TColor;
          Position:TPosition;
          Width:integer;
          Height:integer;
          Top:integer;
          Left:integer;
          ismax:boolean;
          indentchars:integer;
          artificiallines:boolean;
          wordwrap:boolean;
          casesensitive:boolean;
          regularexp:boolean;
          Navigator:ViewData;
          Semantik:ViewData;
          Explorer:ViewData;
          Source:ViewData;
          Cfa:ViewData;
          Dfa:ViewData;
          Measures:ViewData;
          Funktion:ViewData;
          Miniatur:ViewData;
          Druckvorschau:ViewData;
          Execution:ViewData;
          Inspector:ViewData;
          Frame1Page1Max:boolean;
          Frame1Page2Max:boolean;
          Frame2Page1Max:boolean;
          Frame3Page1Max:boolean;
          Frame3Height:integer;
          InspectorVisible:boolean;
          Inspectorheight:integer;
          Frame1Width:integer;
          ThumbnailWidth:integer;
          Timeout:integer;
          Drawgrid:boolean;
          ProgramDir:JStringKeyMax;
          HomeDir:JStringKeyMax;
          RemoteDir:JStringKeyMax;
          ExportDir:JStringKeyMax;
          ExecDir:JStringKeyMax;
          CommandFile:JStringKeyMax;
          FirstUse:TDate;
          LastUse:TDate;
          DaysUsed:integer;
          DaysEffectivlyUsed:integer;
          Activated:boolean;
          Edition:Editions;
          Ablauf:TDate;
          FuncSearch:word;
          FuncReplace:word;
          FuncContReplace:word;
          FuncHelp:word;
          Columnumbers:boolean;
          Linenumbers:boolean;
          Blocknumbers:boolean;
          SyntaxHighlight:boolean;
          SyntaxBold:boolean;
          ShowSpaces:boolean;
          ShowURL:boolean;
          Openindex:integer;
          Libraries: array [1..3] of JStringKeyMax;
          History:THistories;
          SearchString:TextStrings;
          ReplaceString:TextStrings;
          LastFilter:JString12;
          InternetAllowed:boolean;
          Vorname:JStringKeyMax;
          Nachname:JStringKeyMax;
          Firma:JStringKeyMax;
          Strasse:JStringKeyMax;
          Hausnummer:JStringKeyMax;
          Ort:JStringKeyMax;
          Postleitzahl:JStringKeyMax;
          Email:JStringKeyMax;
          Coldefine:boolean;
          Timeper1000forProcessing:integer;
          Timeper1000forFrame1:integer;
          Timeper1000forFrame2:integer;
          Timeper10forSearch:integer;
          Timeper10forReplace:integer;
          ServerName:JStringKeyMax;
          ServerDir:JStringKeyMax;
          UserName:JStringKeyMax;
          Password:JStringKeyMax;
          LineThickness:integer;
          Sourceformat:SourceFormats;
          FillUp: array [1..50] of real;
          Activationstart:boolean;
          Createbackup:boolean;
          endofopts:boolean;);
      false:
        (cc: array [0..maxoptsize] of char);
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
  TSourceStack= Class(TObject)
    Filename:Jstring;
    RTFstream:TStream;
    Navlongstream:PLongTexts;
    Navstream:TStream;
    Semlongstream:PLongTexts;
    Semstream:TStream;
    Next,Previous:TSourcestack;
    constructor Create(Name:JString);
    destructor Destroy;override;
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
  TFrameState= Class(TObject)
    Per:Perspective;
    Next,Previous:TFrameState;
    constructor Create();
    destructor Destroy;override;
  end;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
function GetSecrets(Installkey:JString;SK:JString;ProductNumber:char):integer;
procedure SetSecrets(Installkey:JString;V:integer;ProductNumber:char);
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 MouseOver(var P:ViewData):boolean;
function Longeur(PL:PLongTexts;Tx:TTReeNode):JString;
function dllcall(Progdir:JString;var Libraries:AnsiString;var Keys:PAnsiChar;
  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;forcedll:JString):integer;
function netallowed:boolean;
function GetNextRec(TC:PAnsiChar):JString;
procedure OpenStream(TC:PAnsiChar);
procedure proctime(var tim,act:integer;lasttime:TDateTime;len:integer);
//----------------------------------------------------------------------------
//Global Vars
//----------------------------------------------------------------------------
var
  InitiallyAvail:LongInt;
  Opening,Closing,processing:boolean;
  Loading,Splitting:boolean;
  Inspectorkey:JString;
  DiskDrive:JString;
  SourceInfo:JString24;
  DiskType:integer;
  Filters:JString;
  Dom: array [0..2] of char;
  ViewList:TFrameState;
  FileList:TSourceStack;
  AD: array of AllDll;
  ADHandle: array of THandle;
  Extensions: array of LangType;
  netflag:boolean;
  ColumboFileName:JString;
  BatchRun,Recursive: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;
  Previewselected:boolean;
  Presentationdone:boolean;
  //----------------------------------------------------------------------------
  //
  //----------------------------------------------------------------------------
implementation
uses
  //----------------------------------------------------------------------------
  //specific
  //----------------------------------------------------------------------------
  Messages,SysUtils,Variants,Controls,Dialogs,StdCtrls,jpeg,
  StrUtils,Registry,ShellAPI,Math,DateUtils,Windows;
//------------------------------------------------------------------
//framestate
//
//------------------------------------------------------------------
constructor TFrameState.Create();
var
  Fr:Frames;
begin
  inherited Create();
  Next:=nil;
  Previous:=nil;
  for Fr:=F1 to F3 do begin
    Per[Fr].ActiveView:=NoView;
    per[Fr].width:=0;
    per[Fr].height:=0;
    per[Fr].top:=0;
    per[Fr].left:=0;
  end;
end;
//------------------------------------------------------------------
//framestate
//
//------------------------------------------------------------------
destructor TFrameState.Destroy;
begin
  //next.Free;
  Previous.Free;
  //inherited Free;
end;
//------------------------------------------------------------------
//framestate
//
//------------------------------------------------------------------
constructor TSourceStack.Create(Name:Jstring);
begin
  inherited Create();
  Next:=nil;
  Previous:=nil;
  Filename:=Name;
  Navstream:=nil;
  Navlongstream:=nil;
  Semstream:=nil;
  Semlongstream:=nil;
end;
//------------------------------------------------------------------
//framestate
//
//------------------------------------------------------------------
destructor TSourceStack.Destroy;
begin
  Previous.Free;
end;
//------------------------------------------------------------------
//test if net allowed
//
//------------------------------------------------------------------
function netallowed:boolean;
begin
  if not netflag then
    netflag:=ask(140,'In das Internet gehen?','')=mrYes;
  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;
//------------------------------------------------------------------
//
//calc proc time
//
//------------------------------------------------------------------
procedure proctime(var tim,act:integer;lasttime:TDateTime;len:integer);
var
  ratio,bunit:integer;
begin
  //note processing time
  if len>unitofbytes then begin
    act:=MilliSecondsBetween(now,lasttime)div 100;
    bunit:=(len div unitofbytes);
    if bunit>0 then begin
      ratio:=act div bunit;//seconds per 1000 bytes
      if ratio>0 then
        tim:=(tim+ratio)div 2;
    end;
  end;
end;
//-----------------------------------------------------------------
//function dllcall
//set Options.R.
//-----------------------------------------------------------------
function dllcall(Progdir:JString;var Libraries:AnsiString;var Keys:PAnsiChar;
  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;forcedll:JString):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
    inform(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;i:=0;
  while (i<length(Extensions)) do begin
    if Extensions[i].dllname=forcedll then
      hand:=i
    else if (forcedll='') and ispartof(ext,Extensions[i].ext) then
      hand:=i;
    i:=i+1
  end;
  rv:=99;
  if hand<0 then
    errorn(102,'falsche Extension der Datei')
  else
    try
      lib:=Progdir+Extensions[hand].dllname+dlle;
      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('_dllentry'));
        rv:=AD[hand](PLibs,lexlang,Keys,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;
  //-----------------------------------------------------------------
  //-
  //
  //-----------------------------------------------------------------
  procedure SetSecrets(Installkey:JString;V:integer;ProductNumber:char);
  begin
    SetSecretRegistryValue(Installkey,V,AnsiChar(ProductNumber));
    SetSecretFile(Installkey,V,ProductNumber);
  end;
  //-----------------------------------------------------------------
  //-
  //-
  //-----------------------------------------------------------------
  function GetSecrets(Installkey:JString;SK:JString;ProductNumber:char):integer;
  var
    r1,r2:integer;
  begin
    r1:=GetSecretRegistryValue(Installkey,ProductNumber);
    r2:=GetSecretFile(Installkey,SK,ProductNumber);
    if r1<>r2 then
      r2:=-1;
    GetSecrets:=r2
  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
    InSight:=P.Sheet.PageControl.ActivePage=P.Sheet
  end;
  //-----------------------------------------------------------------
  //Tabsheet visible?                                            -
  //-----------------------------------------------------------------
  function GetFramePos(var P:ViewData):TPoint;
  var MP:TPoint;PC:TPageControl;Fr:TFrame;
  begin
    PC:=P.Sheet.Parent as TPageControl;
    MP.X:=PC.Left;MP.Y:=PC.Top;
    Fr:=PC.Parent as TFrame;
    MP.X:=MP.X+Fr.Left;MP.Y:=MP.Y+Fr.Top;
    GetFramePos:=MP;
  end;
  //-----------------------------------------------------------------
  //Tabsheet visible?                                            -
  //-----------------------------------------------------------------
  function MouseOver(var P:ViewData):boolean;
  var MP,FP:TPoint;isin:boolean;
  begin
    FP:=GetFramePos(p);
    MP:=Mouse.CursorPos;
    isin:=(MP.X>=FP.X+P.Sheet.Left) and (MP.X<=FP.X+P.Sheet.Left+P.sheet.width);
    isin:=isin and (MP.Y>=FP.Y+P.Sheet.top) and (MP.Y<=FP.Y+P.Sheet.Top+P.sheet.height);
    MouseOver:=isin and insight(P)
  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;
end.

quality92%

¤ Dauer der Verarbeitung: 0.13 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.