Quelle UtilitiesOwn.pas
Sprache: Delphi
//------------------------------------------------------------
//
// 1. ...
//
//------------------------------------------------------------
unit UtilitiesOwn;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
interface
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls, StrUtils, WinSock,
Registry, ShellAPI, Math, DateUtils, Utilities;
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
const
Agenda = 1;
Autor = 2;
Columbo = 3;
Egmont = 4;
Productnumber = chr(Autor+ord ('0' ));
em = 1000;
maxoptsize = 512*1024; // maximale Gr��e
EvaluationPeriod = 30;
optkeylen = 8;
Debug = true;
Soft = 'Software' ;
Mickey = 'Microsoft' ;
ActiveSet = 'Active Setup' ;
InstalledComp = 'Installed Components' ;
BigGain = 'Windows\CurrentVersion' ;
FileMax = 32;
KeyMax = 128;
KeyMaxLong = 16384;
SMacAdr = 'macadr.cmd' ;
SMacOut = 'macadr.dat' ;
BorderWidth = 10;
largeprime = 1023;
histmax = 24;
// external values
OptionDll = 'OptionsDll.dll' ;
Installkey = '' ;
//----------------------------------------------------------------------------
// initial and login data
//----------------------------------------------------------------------------
//server = 'medicamentaria.de';
//login = 'medicamenmtaria';
//passwort = 'jdd878';
//homedir = '/Medicamentaria/';
server = 'center-apotheke.de' ;
login = 'centerapotheke' ;
passwort = 'md4989' ;
homedir = '/Center-Apotheke/' ;
artikeldir = 'Artikel/' ;
picsmalldir = 'Artikel\small\' ;
//----------------------------------------------------------------------------
// rtf formats
//----------------------------------------------------------------------------
Paragraph = '\par' ;
SetSize = '\f1\fs' ;
SetColor = '\cf' ; SetNoColor = '\cf0' ;
Underline = '\ul ' ; UnderLineOff = '\ulnone' ;
Bold = '\b' ; BoldOff = '\b0' ;
Strike = '\strike' ; StrikeOff = '\strike0' ;
Italic = '\i' ; ItalicOff = '\i0' ;
Font1 = '\f1 ' ;
Font2 = '\i\f2 ' ; Font0 = '\i0' ;
SetBackColor = '\f1\cb1\cf' ; SetNoBackColor = '' ; // funktioniert nicht
Omega = '\u963?' ; // Achtung: Zahl (963) ist dezimal
Summenzeichen = '\u931?' ; // dito
Produktzeichen = '\u928?' ; // dito
//----------------------------------------------------------------------------
// certain keys
//----------------------------------------------------------------------------
Key_Return = 13;
Key_Enter = 13;
Key_LineFeed = 10;
Key_BackSpace = 8;
Key_Escape = 27;
Key_Tab = 9;
Key_Blank = 32;
Key_F1 = 112;
Key_F2 = 113;
Key_F3 = 114;
Key_F4 = 115;
Key_F5 = 116;
Key_F6 = 117;
Key_F7 = 118;
Key_F8 = 119;
Key_F9 = 120;
Key_F10 = 121;
Key_F11 = 122;
Key_F12 = 123;
Key_Insert = 45;
Key_Delete = 46;
Key_Up = 38;
Key_Down = 40;
Key_Left = 37;
Key_Right = 39;
Key_Ctrl = 17;
Key_Shift = 16;
crlf = chr(Key_Return)+chr(Key_Linefeed);
//----------------------------------------------------------------------------
// Program Parameters
//----------------------------------------------------------------------------
Title = 'Autor' ;
Version = '0.7.11' ;
CopyRight = '�' ;
Trademark = '�' ;
SOptions = 'AutorOptions.Dat' ;
SAutor = 'autor.exe' ;
SamplesDir = 'Workspace\Sample Programs\' ;
ExecDir = 'Workspace\Object Files\' ;
Workspace = 'Workspace\' ;
Remotedirectory = 'Workspace\Remote Files\' ;
CopyLib = 'Copy Library\' ;
XMLTags:array [1..9] of String =
('OVERHEAD' , 'HEADLINE' , 'DATE' , 'ABSTRACT' , 'TEXT' ,
'AUTHOR' , 'PICBIG' , 'PICCREDIT' , 'PICSMALL' );
//----------------------------------------------------------------------------
//
//----------------------------------------------------------------------------
type
//----------------------------------------------------------------------------
// Languages and Sounds
//----------------------------------------------------------------------------
Texte = String [KeyMax];
RTFTexte = array [0..KeyMaxLong] of char ;
ArticleType = (Angebote,Aktuelles,Empfehlung,Heute,Gestern,Vorgestern);
//----------------------------------------------------------------------------
// Options
//----------------------------------------------------------------------------
OwnOptions= record
case boolean of
false: (cc:array [0..maxoptsize] of char );
true: (
CheckSum : LongInt ;
inited : char ;
WindowsProductId : string [24];
SecretKey : String [48];
ActualArticle : ArticleType;
DocumentName : String [24];
Groupname : String [24];
Overhead : Texte;
Headline : Texte;
ElementName : array [1..9] of String [24];
name : array [Angebote .. Vorgestern] of Texte;
Bild : array [Angebote .. Vorgestern] of Texte;
xmlfile : array [Angebote .. Vorgestern] of Texte;
Ueberschrift : array [Angebote .. Vorgestern] of RTFTexte;
RtfText : array [Angebote .. Vorgestern] of RTFTexte;
UeberschriftXML : array [Angebote .. Vorgestern] of RTFTexte;
TextXML : array [Angebote .. Vorgestern] of RTFTexte;
readonly : array [Angebote .. Vorgestern] of boolean ;
HTMLPrefix : RTFTexte;
HTMLSuffix : RTFTexte;
Internetsite : Texte;
Ftpsite : Texte;
Ftpuser : Texte;
Ftppassword : Texte;
RemoteDir : Texte;
RemotePicSmallDir : Texte;
RemotePicBigDir : Texte;
LocalDir : Texte;
BackgroundColor : TColor;
ButtonColor : TColor;
ButtonSize : integer ;
FontName : String [48];
Font2Name : String [48];
FontColor : TColor;
FontStyle : TFontStyles;
FontSize : integer ;
Width : integer ;
Height : integer ;
BWidth : integer ;
BHeight : integer ;
Top : integer ;
Left : integer ;
Horsplitter : integer ;
VerSplitter : integer ;
ProgDir : String [KeyMax];
Workspace : String [KeyMax];
HomeDir : String [KeyMax];
SampleDir : String [KeyMax];
ExportDir : String [KeyMax];
ExecDir : String [KeyMax];
FirstUse : TDate;
LastUse : TDate;
DaysUsed : integer ;
DaysEffectivlyUsed : integer ;
Activated : boolean ;
Edition : Editions;
Ablauf : TDate;
FuncSearch : word ;
FuncReplace : word ;
FuncContReplace : word ;
FuncHelp : word ;
endofopts : boolean ;)
end ;
//----------------------------------------------------------------------------
// Utility Functions
//----------------------------------------------------------------------------
function Lengthrtf(T:RtfTexte):longint ;
Procedure DefaultOptions(var Opt:OwnOptions);
//----------------------------------------------------------------------------
// Constants
//----------------------------------------------------------------------------
const
EditionStrings:array [Editions] of String =
('Shareware' ,'Standard' ,'Professional' ,'Enterprise' );
//----------------------------------------------------------------------------
// Global Vars
//----------------------------------------------------------------------------
var
BatchRun,Recursive : boolean ;
LogFileOpen : boolean ;
LogFile : TExt;
Im_Root : integer ;
Im_Branch : integer ;
Im_Level : integer ;
Im_State : integer ;
im_Error : integer ;
Dom : array [0..2] of char ;
P6,P7 : PChar;
InitialMemory : longint ;
MS : TMemoryStatus;
Lizenzmeldung : boolean ;
Opening, Closing, Loading : boolean ;
Inspectorkey : String ;
//----------------------------------------------------------------------------
// I m p l e m e n t a t i o n
//----------------------------------------------------------------------------
implementation
{------------------------------------------------------------------}
{- Procedure PutOptions -}
{- set Options -}
{------------------------------------------------------------------}
function Lengthrtf(T:RtfTexte):longint ;
var l,e:integer ;
begin
e:=0;
for l:=0 to KeyMaxLong do
if T[l]=chr(0) then e:=l;
Lengthrtf:=e
end ;
{------------------------------------------------------------------}
{- Procedure KeyFile -}
{- set Cryptokey -}
{------------------------------------------------------------------}
Function KeyFile(var Key:array of char ):String ;
var i,nu:integer ;KeyF:String ;
begin
KeyF:=getDiskId(PChar(MidStr(GetCurrentDir,1,3)));
KeyF:=StringReplace(KeyF,' ' ,'X' ,[rfReplaceAll]);
KeyF:='O' +KeyF;
for i:=1 to Length(KeyF) do begin
nu:=(ord (KeyF[i])+7) mod 26;
nu:=nu+ord ('a' );
KeyF[i]:=chr(nu);
end ;
KeyFile:='F' +KeyF+'.key' ;
end ;
{------------------------------------------------------------------}
{- Procedure DefaultOptions -}
{- set Options -}
{------------------------------------------------------------------}
Procedure DefaultOptions(var Opt:OwnOptions);
var i:Integer ;Prog:String ;a:ArticleType;
begin
for i:=1 to maxoptsize do Opt.cc[i] := ' ' ;
Opt.homeDir := ExtractFilePath(Optionsfilename(Title));
Opt.ProgDir := ExtractFilePath(ParamStr(0));
Opt.SampleDir := Opt.ProgDir+SamplesDir;
Opt.Workspace := Opt.ProgDir+Workspace;
Opt.ExecDir := Opt.ProgDir+ExecDir;
Opt.ExportDir := GetCurrentDir;
//-----------------------------------------------------------------------------
// Licensing
//-----------------------------------------------------------------------------
Opt.WindowsProductId := GetWinProductId;
Opt.Activated := false;
Opt.FirstUse := DateOf(Now);
Opt.LastUse := DateOf(Now);
Opt.DaysEffectivlyUsed := 0;
Opt.DaysUsed := 0;
Opt.Edition := Shareware;
Opt.Activated := false;
//-----------------------------------------------------------------------------
// optionen
//-----------------------------------------------------------------------------
Opt.Overhead := '' ;
Opt.Headline := '' ;
Opt.ActualArticle := Heute;
Opt.DocumentName := 'COCOCO' ;
Opt.Groupname := 'ARTICLE' ;
for i:=1 to 9 do
Opt.ElementName[i] := XMLTags[i];
Opt.LocalDir := ExtractFilePath(OptionsFilename(Title))+artikeldir;
Opt.RemoteDir := '/httpdocs/' +artikeldir;
Opt.RemotePicSmallDir := 'small/' ;
Opt.RemotePicBigDir := 'big/' ;
Opt.HTMLPrefix := '' ;
Opt.HTMLSuffix := '' ;
Opt.Internetsite := 'www.' +server+':9080' +homedir;
Opt.Ftpsite := 'ftp.' +server;
Opt.Ftpuser := login;
Opt.Ftppassword := passwort;
//
Opt.name[Angebote] := 'Angebote' ;
Opt.name[Aktuelles] := 'Aktuelles' ;
Opt.name[Empfehlung] := 'Empfehlung' ;
Opt.name[Heute] := 'Heute' ;
Opt.name[Gestern] := 'Gestern' ;
Opt.name[Vorgestern] := 'Vorgestern' ;
Opt.xmlfile[Angebote] := 'angebote.xml' ;
Opt.xmlfile[Aktuelles] := 'aktuelles.xml' ;
Opt.xmlfile[Empfehlung] := 'empfehlung.xml' ;
Opt.xmlfile[Heute] := 'today.xml' ;
Opt.xmlfile[Gestern] := 'yesterday.xml' ;
Opt.xmlfile[Vorgestern] := 'beforeyesterday.xml' ;
for a:=low (ArticleType) to High (ArticleType) do begin
Opt.Ueberschrift[a] := '' ;
Opt.Bild[a] := '' ;
Opt.RtfText[a] := '' ;
Opt.readonly[a] := false;
end ;
for a:=Heute to Vorgestern do
Opt.readonly[a] := true;
//
Opt.Width := 650;
Opt.Height := 360;
Opt.BWidth := 800;
Opt.BHeight := 600;
Opt.Horsplitter := Opt.Height div 3;
Opt.VerSplitter := Opt.Width div 3;
Opt.Top := (Screen.Height) div 8;
Opt.Left := (screen.Width div 2) - (Opt.Width div 2);
//
Prog := Opt.ProgDir + SAutor;
Opt.BackgroundColor := clWhite;
Opt.ButtonSize := 5;
Opt.FontName := 'Fixedsys' ;
Opt.FontName := 'Courier New' ;
Opt.FontSize := 9;
Opt.Edition := Shareware;
Opt.FuncHelp := Key_F1;
Opt.FuncSearch := Key_F3;
Opt.FuncReplace := Key_F4;
Opt.FuncContReplace := Key_F5;
Opt.FuncHelp := Key_F1;
Opt.EndofOpts := True;
Opt.inited := 'j' ;
Opt.CheckSum := 0;
end ;
{------------------------------------------------------------------}
{- -}
{- Ende dieser Quelle -}
{- -}
{------------------------------------------------------------------}
end .
quality 94%
¤ Dauer der Verarbeitung: 0.16 Sekunden
(vorverarbeitet)
¤
*© Formatika GbR, Deutschland
2026-03-28