home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 March / Chip_2002-03_cd1.bin / zkuste / delphi / kolekce / d123456 / SIMONS.ZIP / Units / SRUtils.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-12-21  |  38.7 KB  |  1,327 lines
  1. unit SRUtils;
  2.  
  3. {----------------------------------------------------------------------}
  4. {  Version  : 1.34                                                     }
  5. {  Autor    : Simon Reinhardt                                          }
  6. {  eMail    : reinhardt@picsoft.de                                     }
  7. {  Internet : http://www.picsoft.de                                    }
  8. {                                                                      }
  9. {  Hilfreiche Prozeduren und Funktionen, die die Borland-Programmierer }
  10. {  offensichtlich vergessen haben.                                     }
  11. {----------------------------------------------------------------------}
  12.  
  13. {----------------------------------------------------------------------}
  14. { Version 1.34:                                                        }
  15. { Neu: TrimChars                                                       }
  16. {                                                                      }
  17. { Version 1.33:                                                        }
  18. { Neu: StrToTimeDef, TimeToStrDef                                      }
  19. {                                                                      }
  20. { Version 1.32:                                                        }
  21. { Neu: GetDaysPerYear                                                  }
  22. { GeΣndert: StripForbiddenChars                                        }
  23. {                                                                      }
  24. { Version 1.31:                                                        }
  25. { Neu: PosN                                                            }
  26. {                                                                      }
  27. { Version 1.30:                                                        }
  28. { Neu: GetShiftState                                                   }
  29. {                                                                      }
  30. { Version 1.29:                                                        }
  31. { Neu: ExtractFileDir, LastDelimiter                                   }
  32. { GeΣndert: GetExeForProtocol, FindAssociatedProgram                   }
  33. {                                                                      }
  34. { Version 1.28:                                                        }
  35. { GeΣndert: DateTimeToStrDef, DateToStrDef                             }
  36. { Neu: Konstante PeriodNames                                           }
  37. {                                                                      }
  38. { Version 1.27:                                                        }
  39. { Neu: GetWindowState, GetSystemWorkArea                               }
  40. {                                                                      }
  41. { Version 1.26:                                                        }
  42. { Neu: GetFirstDayOfWeek                                               }
  43. { GeΣndert: IsSummerTime,                                              }
  44. { Initialisierung von FirstWeekDay und FirstWeekDate in Delphi 1       }
  45. {                                                                      }
  46. { Version 1.25:                                                        }
  47. { Neu: GetHourFromTime, GetMinuteFromTime, GetSecondFromTime           }
  48. { GeΣndert: GetDayFromDate, GetMonthFromDate, GetYearFromDate          }
  49. {                                                                      }
  50. { Version 1.24:                                                        }
  51. { GeΣndert: Konstanten ShortForbiddenChars und LongForbiddenChars      }
  52. {                                                                      }
  53. { Version 1.23:                                                        }
  54. { GeΣndert: GetWeekOfYear, GetWeeksPerYear                             }
  55. {                                                                      }
  56. { Version 1.22:                                                        }
  57. { Neu: DateToStrDef, StrToDateDef, GetWeeksPerYear                     }
  58. { GeΣndert: GetFirstPartOfString, AddBackSlash                         }
  59. {                                                                      }
  60. {----------------------------------------------------------------------}
  61.  
  62. interface
  63.  
  64. {$I SRDefine.inc}
  65.  
  66. {$IFDEF SR_Delphi1}
  67. uses WinTypes, WinProcs, Graphics, Classes;
  68. {$ELSE}
  69. uses Windows, Graphics, Classes;
  70. {$ENDIF}
  71.  
  72.  
  73. const
  74.   { Standard Encarta & FlatStyle Color Constants     }
  75.   { Diese konstanten hat maik Porkert am 31.10.2000  }
  76.   { in de.comp.lang.delphi.non-tech gepostet.        }
  77.   { Ich stelle Sie hier zur Verfⁿgung:               }
  78.  
  79.   ecDarkBlue = TColor($00996633);
  80.   ecBlue = TColor($00CF9030);
  81.   ecLightBlue = TColor($00CFB78F);
  82.  
  83.   ecDarkRed = TColor($00302794);
  84.   ecRed = TColor($005F58B0);
  85.   ecLightRed = TColor($006963B6);
  86.  
  87.   ecDarkGreen = TColor($00385937);
  88.   ecGreen = TColor($00518150);
  89.   ecLightGreen = TColor($0093CAB1);
  90.  
  91.   ecDarkYellow = TColor($004EB6CF);
  92.   ecYellow = TColor($0057D1FF);
  93.   ecLightYellow = TColor($00B3F8FF);
  94.  
  95.   ecDarkBrown = TColor($00394D4D);
  96.   ecBrown = TColor($00555E66);
  97.   ecLightBrown = TColor($00829AA2);
  98.  
  99.   ecDarkKaki = TColor($00D3D3D3);
  100.   ecKaki = TColor($00C8D7D7);
  101.   ecLightKaki = TColor($00E0E9EF);
  102.  
  103.   {$IFDEF SR_Delphi1}
  104.   Max_Path = 255;
  105.   {$ENDIF}
  106.   { Ungⁿltige Zeichen fuer 8.3-Dateinamen im DOS-Format: }
  107.   ShortForbiddenChars :
  108.     set of char = [':','?','*',';','=','+','<','>','|','"','[',']',' ','\',#39];
  109.   { Ungⁿltige Zeichen fuer lange Dateinamen im Win9x-Format: }
  110.   LongForbiddenChars :
  111.     set of char = ['\','/',':','*','?','"','<','>','|'];
  112.   { Bezeichner fⁿr relative Datumsangaben in DateTimeToStrDef und DateToStrDef: }
  113.   PeriodNames :
  114.     array [0..4] of string = ('▄bermorgen', 'Morgen', 'Heute', 'Gestern', 'Vorgestern');
  115.  
  116. type
  117.   TFileSizeFormat = (fsByte, fsKilobyte, fsMegabyte);
  118.   { Rⁿckgabe-Formate fⁿr die Funktion GetFileSize }
  119.  
  120. {---------------------------------------}
  121. { Funktionen fⁿr alle Delphi-Versionen: }
  122. {---------------------------------------}
  123.  
  124. function AddBackslash(FileName:string):string;
  125.  { erweitert den Dateinamen mit einem abschlie▀enden Backslash }
  126. function CutBackSlash(FileName:string):string;
  127.  { entfernt den abschlie▀enden Backslash aus dem Dateinamen }
  128. function CutRootDirectory(FName:string):string;
  129.  { entfernt das Stammverzeichnis aus einem Dateinamen }
  130. function DateTimeToStrDef(ADate:TDateTime;Default:string;CompareToday:boolean):string;
  131.  { Umwandlung DateTime->String mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  132. function DateToStrDef(ADate:TDateTime;Default:string;CompareToday:boolean):string;
  133.  { Umwandlung Date->String mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  134. function ExecAndWait(const Filename,Params:string;WindowState:word):boolean;
  135.  { Startet ein Programm und wartet auf dessen Ende }
  136. function ExpandString(S:string;AChar:char;ALength:word):string;
  137.  { Erweitert einen String mit dem Zeichen "AChar" auf die LΣnge ALength }
  138. function ExtractRawFileName(DName:string):string;
  139.  { Gibt von einem vollen Dateinamen mit Pfad nur den Dateinamen ohne Erweiterung zurⁿck }
  140. function GetBuildInfo(const AFilename:String; var V1,V2,V3,V4:Word):Boolean;
  141.  { Ermittelt die vier Versionsnummern einer Exe- oder Dll-Datei }
  142. function GetDayFromDate(ADate:TDateTime):word;
  143.  { Gibt den Tag im Monat aus einem Datums-Wert zurⁿck }
  144. function GetDayOfYear(ADate:TDateTime):word;
  145.  { Gibt den Tag im Jahr aus einem Datums-Wert zurⁿck }
  146. function GetDaysPerMonth(AYear,AMonth:integer):integer;
  147.  { Gibt die Anzahl Tage in einem Monat zurⁿck }
  148. function GetDaysPerYear(AYear:integer):integer;
  149.  { Gibt die Anzahl Tage in einem Jahr zurⁿck }
  150. function GetFileSize(FileName:string;AFormat:TFileSizeFormat):integer;
  151.  { Ermittelt die Gr÷▀e der Datei "FileName" im Format "AFormat" }
  152. function GetFirstDayOfWeek(ADate:TDateTime):TDateTime;
  153.  { Gibt den ersten Tag der Woche zurⁿck, in dem das Datum ADate liegt }
  154. function GetFirstPartOfString(var AText:string;Delimiter:char;IncludeDelimiter:boolean):string;
  155.  { Extrahiert aus einem String den ersten Teil bis zum Zeichen "Delimiter" und entfernt
  156.    diesen Teil aus dem String "AText" }
  157. function GetHourFromTime(ATime:TDateTime):byte;
  158.  { Gibt die Stunde aus einem Zeit-Wert zurⁿck }
  159. function GetMinuteFromTime(ATime:TDateTime):byte;
  160.  { Gibt die Minute aus einem Zeit-Wert zurⁿck }
  161. function GetMonthFromDate(ADate:TDateTime):word;
  162.  { Gibt den Monat aus einem Datums-Wert zurⁿck }
  163. function GetSecondFromTime(ATime:TDateTime):byte;
  164.  { Gibt die Sekunde aus einem Zeit-Wert zurⁿck }
  165. function GetShiftState:TShiftState;
  166.  { Ermittelt den Zustand der Shift-, Alt- und Ctrl-Tasten }
  167. function GetSystemDir:string;
  168.  { Ermittelt das Windows-System-Verzeichnis }
  169. function GetVersionNr(ExeName:string;BuildNr:boolean):string;
  170.  { Generiert einen Versionsnummern-string zu einer Exe- oder Dll-Datei }
  171. function GetWeekOfYear(ADate:TDateTime):byte;
  172.  { Gibt die Woche im Jahr aus einem Datums-Wert zurⁿck }
  173. function GetWeeksPerYear(AYear:word):byte;
  174.  { Gibt die Wochenzahl der letzten Woche im Jahr "AYear" zurⁿck }
  175. function GetWindowsDir:string;
  176.  { Ermittelt das Windows-Verzeichnis }
  177. function GetYearFromDate(ADate:TDateTime):word;
  178.  { Gibt das Jahr aus einem Datums-Wert zurⁿck }
  179. function IntToStrFixed(IntValue:integer;OutDigits:byte):string;
  180.  { Umwandlung Int->String mit fester Stellenzahl und fⁿhrenden Nullen }
  181. function IsSummertime(ADate:TDateTime):boolean;
  182.  { Ermmittelt, ob ein Datum in der Sommerzeit liegt }
  183. function PosN(const AText,S:string;N:integer):integer;
  184.  { Entspricht der Pos()-Funktion, sucht aber erst ab der Textposition "N" }
  185. function ReverseString(AText:string):string;
  186.  { Spiegelt einen String, die Buchstabenfolge wird umgedreht }
  187. function RGBToStr(RGBColor:integer):string;
  188.  { Umwandlung Windows-RGB-Wert -> HTML-RGB-Wert }
  189. function StripForbiddenChars(AText:string):string;
  190.  { Entfernt fⁿr Dateinamen nicht erlaubte Zeichen aus einem String }
  191. function StrToDateDef(S:string;Def:TDateTime):TDateTime;
  192.  { Umwandlung String->Date mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  193. function StrToDateTimeDef(S:string;Def:TDateTime):TDateTime;
  194.  { Umwandlung String->DateTime mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  195. function StrToFloatDef(S:string;Def:extended):extended;
  196.  { Umwandlung String->Extended mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  197. function StrToTimeDef(S:string;Def:TDateTime):TDateTime;
  198.  { Umwandlung String->Time mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  199. function TimeToStrDef(ADate:TDateTime;Default:string):string;
  200.  { Umwandlung Time->String mit Rⁿckgabe eines Default-Wertes bei Fehlern }
  201. function TrimChars(const AChar:char;const AText:string):string;
  202.  { Entfernt alle Zeichen "AChar" von Anfang und Ende des Strings "AText" }
  203. function ValidFileName(DName:string):boolean;
  204.  { Ermittelt, ob es sich um einen gⁿltigen Dateinamen handelt }
  205.  
  206.  
  207. {---------------------------------------}
  208. { Funktionen nur fⁿr Delphi 1:          }
  209. {---------------------------------------}
  210.  
  211. {$IFDEF SR_Delphi1}
  212. procedure DrawEdge(ACanvas:TCanvas;ARect:TRect;Raised:boolean);
  213.  { Zeichnet einen 3D-Rahmen auf der ZeichenflΣche ACanvas }
  214. procedure SetFileDate(FName:string;FDate:LongInt);
  215.  { Setzt das Erstellungs-Datum einer Datei }
  216. function Trim(const AText:string):string;
  217.  { Entfernt fⁿhrende und abschlie▀ende Leerzeichen aus einem String }
  218. {$ENDIF}
  219.  
  220.  
  221. {---------------------------------------}
  222. { Funktionen nur fⁿr alle 32Bit-        }
  223. { Delphi-Versionen                      }
  224. {---------------------------------------}
  225.  
  226. {$IFDEF SR_Delphi2_Up}
  227. function ConvertStrToDateTime(s:String):TDateTime;
  228.  { Versucht, einen String in einen Datumswert zu wandeln
  229.    (zuvor mu▀ InitLocale aufgerufen werden) }
  230. function FindAssociatedProgram(DateiName:String):String;
  231.  { Ermittelt das mit einer Dateierweiterung verknⁿpfte Programm }
  232. function GetExeForProtocol(URL:string):string;
  233.  { Ermittelt das mit einem ▄bertragungs-Protokoll verknⁿpfte Programm }
  234. function GetFocussedControl:HWnd;
  235.  { Ermittelt das Fensterelement mit dem Eingabefokus }
  236. function GetLongPathName(APath:String):String;
  237.  { Wandelt einen verkⁿrzten DOS-Dateinamen in einen langen Windows9x-Dateinamen }
  238. function GetSystemFileDescription(FileName:string):string;
  239.  { Liefert die in Windows registrierte Dateibeschreibung zu einem Dateinamen zurⁿck }
  240. function GetSystemWorkArea:TRect;
  241.  { Gibt das Windows-Desktop-Rechteck ohne die Taskbar zurⁿck }
  242. function GetWindowState(WHandle:HWnd):integer;
  243.  { Gibt den Anzeige-Zustand des Fenster mit dem Handle "WHandle" zurⁿck }
  244. function GetWinUsername:string;
  245.  { Ermittelt den aktuell angemeldeten Windows-Benutzer }
  246. procedure InitLocale;
  247.  { Ermittelt die aktuellen Lokalisierungseinstellungen
  248.    (mu▀ vor  ConvertStrToDateTime aufgerufen werden) }
  249. function IsWindowsNT:boolean;
  250.  { Ermittelt ob es sich bei dem Betriebssystem um eine Windows-NT-Version handelt }
  251. procedure SendKeys(AText:string);
  252.  { Sendet einen String als Folge von Tastendrⁿcken an ein Fensterelement }
  253. function SetFileDate(FName:string;FDate:Integer):boolean;
  254.  { Setzt das Erstellungs-Datum einer Datei }
  255. procedure SimulateKeyDown(Key : byte);
  256.  { Sendet eine KeyDown-Nachricht an ein Fensterelement }
  257. procedure SimulateKeystroke(Key:byte; extra:DWORD);
  258.  { Sendet einen vollstΣndigen Tatendruck (KeyDown+KeyUp) an ein Fensterelement }
  259. procedure SimulateKeyUp(Key : byte);
  260.  { Sendet eine KeyUp-Nachricht an ein Fensterelement }
  261. {$ENDIF}
  262.  
  263.  
  264. {---------------------------------------}
  265. { Funktionen nur fⁿr bestimmte          }
  266. { Delphi-Versionen                      }
  267. {---------------------------------------}
  268.  
  269. {$IFNDEF SR_Delphi4_Up}
  270. procedure FreeAndNil(var Obj);
  271.  { Gibt ein Objekt frei und setzt den Objektzeiger auf NIL (Delphi 1..3) }
  272. {$ENDIF}
  273. {$IFNDEF SR_Delphi3_Up}
  274. function ExtractFileDir(APath:string):string;
  275.  { Gibt wie ExtractFilePath den Pfad eines Dateinamens zurⁿck,
  276.   aber ohne abschlie▀enden Backslash }
  277. function IsLeapYear(AYear: Integer):boolean;
  278.  { Ermittelt, ob ein Jahr ein Schaltjahr ist (Delphi 1..2) }
  279. function LastDelimiter(AChar:char;AText:string):integer;
  280.  { Ermittelt die letzte Position des Zeichens AChar im string AText (Delphi 1..2) }
  281. {$ENDIF}
  282.  
  283. implementation
  284.  
  285. uses SysUtils {$IFDEF SR_Delphi2_Up}, Registry, ShellAPI {$ELSE}, Forms, Ver {$ENDIF};
  286.  
  287. var
  288.   {$IFDEF SR_Delphi2_Up}
  289.   FirstWeekDay  : Integer = 2;  { Wochentag, mit dem die Woche beginnt
  290.                                   (siehe Delphi-Wochentage)
  291.                                   2 : Montag (nach DIN 1355) }
  292.   FirstWeekDate : Integer = 4;  { 1 : Beginnt am ersten Januar
  293.                                   4 : Erste-4 Tage-Woche (nach DIN 1355)
  294.                                   7 : Erste volle Woche }
  295.   {$ELSE}
  296.   FirstWeekDay  : Integer;
  297.   FirstWeekDate : Integer;
  298.   {$ENDIF}
  299.   LocaleIDate,
  300.   LocaleILDate,
  301.   CurrentYear2Digit,
  302.   CurrentCentury    : Integer;
  303.  
  304. function AddBackslash(Filename:string):string;
  305. begin
  306.   if (length(Filename)>0) and (Filename[length(Filename)]<>'\') then
  307.     Result:=Filename+'\'
  308.   else
  309.     Result:=Filename;
  310. end; {AddBackslash}
  311.  
  312. {$IFDEF SR_Delphi2_Up}
  313. function ConvertStrToDateTime(s:String):TDateTime;
  314. var
  315.   p,p2     : PChar;
  316.   i1,i2,i3 : Integer;    { einzelne Datumsangaben }
  317.   Mode     : Integer;    { Reihenfolge beim Datum }
  318.   t1,t2    : String;     { Separator }
  319.   t        : String;     { Zeit }
  320.  
  321.   function GetNumber:Integer;
  322.   var s : String;
  323.   begin
  324.     p:=p2;
  325.     while p2^ in ['0'..'9'] do
  326.       Inc(p2);
  327.     SetString(s,p,p2-p);
  328.     Result:=StrToIntDef(s,-1);
  329.   end; {GetNumber}
  330.  
  331.   function GetSeparator:String;
  332.   begin
  333.     p:=p2;
  334.     while Not (p2^ in ['0'..'9',#0]) do
  335.       Inc(p2);
  336.     SetString(Result,p,p2-p);
  337.     Result:=Trim(Result);
  338.   end; {GetSeparator}
  339.  
  340.   procedure ConvertTo4Digit(var AYear:Integer);
  341.   begin
  342.     if AYear in [0..100] then begin
  343.       if AYear>CurrentYear2Digit then
  344.         Dec(AYear,100);
  345.       Inc(AYear,CurrentCentury);
  346.     end;
  347.   end; {ConvertTo4Digit}
  348.  
  349. begin
  350.   Result:=0;
  351.   p:=Pointer(s);
  352.   if p=Nil then
  353.     Exit;
  354.   p2:=p;
  355.   i1:=GetNumber;
  356.   t1:=GetSeparator;
  357.   i2:=GetNumber;
  358.   t2:=GetSeparator;
  359.   i3:=GetNumber;
  360.   SetString(t,p2,StrLen(p2));
  361.   t:=Trim(t);
  362.   Mode:=-1;
  363.   if (i1<1) or (i1>31) then           { y/m/d }
  364.     Mode:=2
  365.   else begin
  366.     if (i3<1) or (i3>31) then begin   { x/x/y }
  367.       if Not (i1 in [1..31]) then     { m/d/y }
  368.         Mode:=0
  369.       else
  370.         if Not (i2 in [1..31]) then   { d/m/y }
  371.           Mode:=1;
  372.     end
  373.     else
  374.       if i1=i2 then                   { Tag=Monat, Format egal }
  375.         Mode:=1;
  376.   end;
  377.   if Mode<0 then begin                { Format nicht auswertbar }
  378.     if LocaleIDate in [0..1] then
  379.       Mode:=LocaleIDate               { Reihenfolge kurzes Datum }
  380.     else begin
  381.       if LocaleILDate in [0..1] then
  382.         Mode:=LocaleILDate            { Reihenfolge langes Datum }
  383.       else                            // evtl. User befragen
  384.         Mode:=1;
  385.     end;
  386.   end;
  387.   // Jahr auf vierstellig bringen
  388.   case Mode of
  389.     0..1 : ConvertTo4Digit(i3);
  390.     2    : ConvertTo4Digit(i1);
  391.   end;
  392.   // Datum konvertieren
  393.   case Mode of
  394.     0 : Result:=EncodeDate(i3,i1,i2);
  395.     1 : Result:=EncodeDate(i3,i2,i1);
  396.     2 : Result:=EncodeDate(i1,i2,i3);
  397.   end;
  398.   if Length(t)>0 then
  399.     Result:=Result+StrToTime(t);
  400. end; {ConvertStrToDateTime}
  401. {$ENDIF}
  402.  
  403. function CutBackSlash(FileName:string):string;
  404. begin
  405.   if (length(FileName)>0) and (FileName[length(FileName)]='\') then
  406.     Result:=copy(FileName,1,length(FileName)-1)
  407.   else
  408.     Result:=FileName;
  409. end; {CutBackSlash}
  410.  
  411. function CutRootDirectory(FName:string):string;
  412. var P : integer;
  413. begin
  414.   P:=Pos(':',FName);
  415.   if (P>0) and (P<length(FName)) then
  416.     delete(FName,1,P+1);
  417.   Result:=FName;
  418. end; {CutRootDirectory}
  419.  
  420. function DateTimeToStrDef(ADate:TDateTime;Default:string;CompareToday:boolean):string;
  421. var DayDiff : integer;
  422. begin
  423.   try
  424.     Result:='';
  425.     if CompareToday then begin
  426.       DayDiff:=trunc(Date)-trunc(ADate);
  427.       if (abs(DayDiff))<=2 then
  428.         Result:=PeriodNames[DayDiff+2]+', '+TimeToStr(frac(ADate));
  429.     end;
  430.     if Result='' then
  431.       Result:=DateTimeToStr(ADate);
  432.   except
  433.     Result:=Default;
  434.   end;
  435. end; {DateTimeToStrDef}
  436.  
  437. function DateToStrDef(ADate:TDateTime;Default:string;CompareToday:boolean):string;
  438. var DayDiff : integer;
  439. begin
  440.   try
  441.     Result:='';
  442.     if CompareToday then begin
  443.       DayDiff:=trunc(Date)-trunc(ADate);
  444.       if (abs(DayDiff))<=2 then
  445.         Result:=PeriodNames[DayDiff+2];
  446.     end;
  447.     if Result='' then
  448.       Result:=DateToStr(ADate);
  449.   except
  450.     Result:=Default;
  451.   end;
  452. end; {DateToStrDef}
  453.  
  454. {$IFDEF SR_Delphi1}
  455. procedure DrawEdge(ACanvas:TCanvas;ARect:TRect;Raised:boolean);
  456. begin
  457.   with ACanvas do begin
  458.     if Raised then
  459.       Pen.Color:=clBtnHighlight
  460.     else
  461.       Pen.Color:=clBtnShadow;
  462.     MoveTo(ARect.Right-1,ARect.Top);
  463.     LineTo(ARect.Left,ARect.Top);
  464.     LineTo(ARect.Left,ARect.Bottom-2);
  465.     if Raised then
  466.       Pen.Color:=clBtnShadow
  467.     else
  468.       Pen.Color:=clBtnHighlight;
  469.     MoveTo(ARect.Left,ARect.Bottom-2);
  470.     LineTo(ARect.Right-1,ARect.Bottom-2);
  471.     LineTo(ARect.Right-1,ARect.Top);
  472.     Pen.Color:=clWindowFrame;
  473.     MoveTo(ARect.Left,ARect.Bottom-1);
  474.     LineTo(ARect.Right,ARect.Bottom-1);
  475.     LineTo(ARect.Right,ARect.Top);
  476.   end;
  477. end; {DrawEdge}
  478. {$ENDIF}
  479.  
  480. function ExecAndWait(const Filename, Params: string;
  481.                      WindowState: word): boolean;
  482. {$IFDEF SR_Delphi2_Up}
  483. var
  484.   SUInfo: TStartupInfo;
  485.   ProcInfo: TProcessInformation;
  486.   CmdLine: string;
  487. begin
  488.   { Enclose filename in quotes to take care of
  489.     long filenames with spaces. }
  490.   CmdLine := '"' + Filename + '" ' + Params;
  491.   FillChar(SUInfo, SizeOf(SUInfo), #0);
  492.   with SUInfo do begin
  493.     cb := SizeOf(SUInfo);
  494.     dwFlags := STARTF_USESHOWWINDOW;
  495.     wShowWindow := WindowState;
  496.   end;
  497.   Result := CreateProcess(NIL, PChar(CmdLine), NIL, NIL, FALSE, 
  498.                           CREATE_NEW_CONSOLE or 
  499.                           NORMAL_PRIORITY_CLASS, NIL, 
  500.                           PChar(ExtractFilePath(Filename)), 
  501.                           SUInfo, ProcInfo);
  502.   { Wait for it to finish. }
  503.   if Result then
  504.     WaitForSingleObject(ProcInfo.hProcess, INFINITE);
  505.  
  506. {$ELSE}
  507. var
  508.   InstanceID : THandle;
  509.   Buff: array[0..255] of char;
  510. begin
  511.   StrPCopy(Buff, Filename + ' ' + Params);
  512.   InstanceID := WinExec(Buff, WindowState);
  513.   if InstanceID < 32 then
  514.   { a value less than 32 indicates an Exec error }
  515.     Result := FALSE
  516.   else begin
  517.     Result := TRUE;
  518.     repeat
  519.       Application.ProcessMessages;
  520.     until Application.Terminated or
  521.           (GetModuleUsage(InstanceID) = 0);
  522.   end;
  523. {$ENDIF}
  524. end;
  525.  
  526. function ExpandString(S:string;AChar:char;ALength:word):string;
  527. begin
  528.   while length(S)<ALength do
  529.     S:=AChar+S;
  530.   Result:=S;
  531. end; {ExpandString}
  532.  
  533. {$IFNDEF SR_Delphi3_Up}
  534. function ExtractFileDir(APath:string):string;
  535. begin
  536.   Result:=CutBackslash(ExtractFilePath(APath));
  537. end; {ExtractFileDir}
  538. {$ENDIF}
  539.  
  540. function ExtractRawFileName(DName:string):string;
  541. begin
  542.   Result:=ChangeFileExt(ExtractFileName(DName),'');
  543. end; {ExtractRawFileName}
  544.  
  545. {$IFDEF SR_Delphi2_Up}
  546. function FindAssociatedProgram(DateiName:String):String;
  547. var Reg  : TRegistry;
  548.     Res  : boolean;
  549.     AKey : string;
  550.     i    : integer;
  551. begin
  552.   Result:='';
  553.   {$IFDEF SR_Delphi4_Up}
  554.   Reg := TRegistry.Create(Key_Read);
  555.   {$ELSE}
  556.   Reg := TRegistry.Create;
  557.   {$ENDIF}
  558.   try
  559.     Reg.RootKey := HKEY_CLASSES_ROOT;
  560.     Res:=Reg.OpenKey(ExtractFileExt(DateiName), false);
  561.     if Res then begin
  562.       AKey:=Reg.ReadString('');
  563.       Reg.CloseKey;
  564.       if AKey<>'' then begin
  565.         Res:=Reg.OpenKey(AKey+'\shell\open\command', false);
  566.         if Res then begin
  567.           Result:=Reg.ReadString('');
  568.           for i:=length(Result) downto 1 do
  569.             if Result[i]='"' then
  570.               delete(Result, i, 1);
  571.           i:=Pos(LowerCase('.exe'), LowerCase(Result));
  572.           if i>0 then
  573.             delete(Result, i+4, length(Result)-i-3);
  574.           Result:=GetLongPathName(Result);
  575.           Reg.CloseKey;
  576.         end;
  577.       end;
  578.     end;
  579.   finally
  580.     Reg.Free;
  581.   end;
  582. end; {FindAssociatedProgram}
  583. {$ENDIF}
  584.  
  585. {$IFNDEF SR_Delphi4_Up}
  586. procedure FreeAndNil(var Obj);
  587. var P : TObject;
  588. begin
  589.   P:=TObject(Obj);
  590.   TObject(Obj):=nil;
  591.   P.Free;
  592. end; {FreeAndNil}
  593. {$ENDIF}
  594.  
  595. function GetBuildInfo(const AFilename:String; var V1,V2,V3,V4:Word):Boolean;
  596. var
  597.   VerInfoSize  : Integer;
  598.   {$IFDEF SR_Delphi2_Up}
  599.   VerValueSize : DWord;
  600.   Dummy        : DWord;
  601.   VerValue     : PVSFixedFileInfo;
  602.   {$ELSE}
  603.   VerValueSize : Word;
  604.   Dummy        : LongInt;
  605.   VerValue     : ^TVS_FixedFileInfo;
  606.   {$ENDIF}
  607.   VerInfo      : Pointer;
  608.   FName        : PChar;
  609. begin
  610.   FName:=StrAlloc(Max_Path);
  611.   try
  612.     StrPCopy(FName,AFileName);
  613.     VerInfoSize:=GetFileVersionInfoSize(FName,Dummy);
  614.     Result:=False;
  615.     if VerInfoSize>0 then begin
  616.       GetMem(VerInfo,VerInfoSize);
  617.       try
  618.         if GetFileVersionInfo(FName,0,VerInfoSize,VerInfo) then begin
  619.           if VerQueryValue(VerInfo,'\',Pointer(VerValue),VerValueSize) then
  620.            with VerValue^ do begin
  621.             V1:=dwFileVersionMS shr 16;
  622.             V2:=dwFileVersionMS and $FFFF;
  623.             V3:=dwFileVersionLS shr 16;
  624.             V4:=dwFileVersionLS and $FFFF;
  625.           end;
  626.           Result:=True;
  627.         end;
  628.       finally
  629.         FreeMem(VerInfo,VerInfoSize);
  630.       end;
  631.     end;
  632.   finally
  633.     StrDispose(FName);
  634.   end;
  635. end; {GetBuildInfo}
  636.  
  637. function GetDayFromDate(ADate:TDateTime):word;
  638. var Y,M,D : word;
  639. begin
  640.   try
  641.     Decodedate(ADate, Y, M, D);
  642.   except
  643.     D:=0;
  644.   end;
  645.   Result:=D;
  646. end; {GetDayFromDate}
  647.  
  648. function GetDayOfYear(ADate:TDateTime):word;
  649. { liefert den Tag im Jahr }
  650. var T,M,J  : word;
  651.     Erster : TDateTime;
  652. begin
  653.   try
  654.     DecodeDate(ADate,J,M,T);
  655.     Erster:=EncodeDate(J,1,1);
  656.     Result:=trunc(ADate-Erster+1);
  657.   except
  658.     Result:=0;
  659.   end;
  660. end; {GetDayOfYear}
  661.  
  662. function GetDaysPerMonth(AYear,AMonth:integer):integer;
  663. const
  664.   DaysInMonth: array [1..12] of Integer =
  665.    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
  666. begin
  667.   Result:=DaysInMonth[AMonth];
  668.   if (AMonth=2) and IsLeapYear(AYear) then
  669.     Inc(Result);
  670. end; {GetDaysPerMonth}
  671.  
  672. function GetDaysPerYear(AYear:integer):integer;
  673. var ADate : TDateTime;
  674. begin
  675.   try
  676.     ADate:=EncodeDate(AYear, 12, 31);
  677.     Result:=GetDayOfYear(ADate);
  678.   except
  679.     Result:=0;
  680.   end;
  681. end; {GetDaysPerYear}
  682.  
  683. {$IFDEF SR_Delphi2_Up}
  684. function GetExeForProtocol(URL:string):string;
  685. var Reg  : TRegistry;
  686.     Res  : boolean;
  687.     Temp : string;
  688.     P    : integer;
  689. begin
  690.   Result:='';
  691.   P:=Pos(':', URL);
  692.   if P>1 then
  693.     delete(URL, P, length(URL)-P+1);
  694.   {$IFDEF SR_Delphi4_Up}
  695.   Reg := TRegistry.Create(Key_Read);
  696.   {$ELSE}
  697.   Reg := TRegistry.Create;
  698.   {$ENDIF}
  699.   try
  700.     Reg.Rootkey:=HKEY_CLASSES_ROOT;
  701.     Res:=Reg.OpenKey(URL+'\shell\open\command', false);
  702.     if Res then begin
  703.       Temp:=Reg.ReadString('');
  704.       while (length(Temp)>0) and ((Temp[1]='"') or (Temp[1]=' ')) do
  705.         delete(Temp, 1, 1);
  706.       P:=Pos('"', Temp);
  707.       if P>0 then
  708.         delete(Temp, P, length(Temp)-P+1);
  709.       Result:=Temp;
  710.       Reg.CloseKey;
  711.     end;
  712.   finally
  713.     Reg.Free;
  714.   end;
  715. end; {GetExeForProtocol}
  716. {$ENDIF}
  717.  
  718. function GetFileSize(FileName:string;AFormat:TFileSizeFormat):integer;
  719. var SR : TSearchRec;
  720. begin
  721.   if FindFirst(FileName, faAnyFile, SR)=0 then begin
  722.     Result:=SR.Size;
  723.     if AFormat=fsKilobyte then
  724.       Result:=Result div 1024;
  725.     if AFormat=fsMegabyte then
  726.       Result:=Result div (1024*1024);
  727.     FindClose(SR);
  728.   end
  729.   else
  730.     Result:=-1;
  731. end; {GetFileSize}
  732.  
  733. function GetFirstDayOfWeek(ADate:TDateTime):TDateTime;
  734. begin
  735.   while DayOfWeek(ADate)<>1 do
  736.     ADate:=ADate-1;
  737.   Result:=ADate;
  738. end; {GetFirstDayOfWeek}
  739.  
  740. function GetFirstPartOfString(var AText:string;Delimiter:char;IncludeDelimiter:boolean):string;
  741. var P : integer;
  742. begin
  743.   P:=Pos(Delimiter,AText);
  744.   if P>0 then begin
  745.     if IncludeDelimiter then
  746.       Result:=copy(AText,1,P)
  747.     else
  748.       Result:=copy(AText,1,P-1);
  749.     delete(AText,1,P);
  750.   end
  751.   else
  752.     Result:=AText;
  753. end; {GetFirstPartOfString}
  754.  
  755. function GetHourFromTime(ATime:TDateTime):byte;
  756. var H,M,S,MS : word;
  757. begin
  758.   try
  759.     DecodeTime(ATime, H, M, S, MS);
  760.   except
  761.     H:=0;
  762.   end;
  763.   Result:=H;
  764. end; {GetHourFromTime}
  765.  
  766. function GetMinuteFromTime(ATime:TDateTime):byte;
  767. var H,M,S,MS : word;
  768. begin
  769.   try
  770.     DecodeTime(ATime, H, M, S, MS);
  771.   except
  772.     M:=0;
  773.   end;
  774.   Result:=M;
  775. end; {GetMinuteFromTime}
  776.  
  777. {$IFDEF SR_Delphi2_Up}
  778. function GetFocussedControl:HWnd;
  779. var OtherThreadID,
  780.     Buffer        : DWord;
  781.     ParentWnd     : HWnd;
  782. begin
  783.   Result:=0;
  784.   ParentWnd:=GetForegroundWindow;
  785.   if ParentWnd<>0 then begin
  786.     OtherThreadID:=GetWindowThreadProcessID(ParentWnd, @Buffer);
  787.     if AttachThreadInput(GetCurrentThreadID, OtherThreadID, true) then begin
  788.       Result:=GetFocus;
  789.       AttachThreadInput(GetCurrentThreadID, OtherThreadID, false);
  790.     end;
  791.   end;
  792. end; {GetFocussedControl}
  793.  
  794. function GetLongPathName(APath:String):String;
  795. var
  796.   i : Integer;
  797.   h : THandle;
  798.   Data : TWin32FindData;
  799.   IsBackSlash : Boolean;
  800. begin
  801.   APath:=ExpandFileName(APath);
  802.   i:=Pos('\',APath);
  803.   Result:=Copy(APath,1,i);
  804.   Delete(APath,1,i);
  805.   repeat
  806.     i:=Pos('\',APath);
  807.     IsBackSlash:=i>0;
  808.     if Not IsBackSlash then
  809.       i:=Length(APath)+1;
  810.     h:=FindFirstFile(PChar(Result+Copy(APath,1,i-1)),Data);
  811.     if h<>INVALID_HANDLE_VALUE then begin
  812.       try
  813.         Result:=Result+Data.cFileName;
  814.         if IsBackSlash then
  815.           Result:=Result+'\';
  816.       finally
  817.         Windows.FindClose(h);
  818.       end;
  819.     end
  820.     else begin
  821.       Result:=Result+APath;
  822.       Exit;
  823.     end;
  824.     Delete(APath,1,i);
  825.   until Length(APath)=0;
  826. end; {GetLongPathName}
  827. {$ENDIF}
  828.  
  829. function GetMonthFromDate(ADate:TDateTime):word;
  830. var Y,M,D : word;
  831. begin
  832.   try
  833.     Decodedate(ADate,Y,M,D);
  834.   except
  835.     M:=0;
  836.   end;
  837.   Result:=M;
  838. end; {GetMonthFromDate}
  839.  
  840. function GetSecondFromTime(ATime:TDateTime):byte;
  841. var H,M,S,MS : word;
  842. begin
  843.   try
  844.     DecodeTime(ATime, H, M, S, MS);
  845.   except
  846.     S:=0;
  847.   end;
  848.   Result:=S;
  849. end; {GetSecondFromTime}
  850.  
  851. function GetShiftState:TShiftState;
  852. const Key_Pressed = 65535;
  853. {$IFDEF SR_Delphi1}
  854. var AState : integer;
  855. {$ELSE}
  856. var AState : short;
  857. {$ENDIF}
  858. begin
  859.   Result:=[];
  860.   AState:=GetAsyncKeyState(VK_Shift);
  861.   if (AState and Key_Pressed)>0 then
  862.     Include(Result, ssShift);
  863.   AState:=GetAsyncKeyState(VK_Menu);
  864.   if (AState and Key_Pressed)>0 then
  865.     Include(Result, ssAlt);
  866.   AState:=GetAsyncKeyState(VK_Control);
  867.   if (AState and Key_Pressed)>0 then
  868.     Include(Result, ssCtrl);
  869. end; {GetShiftState}
  870.  
  871. function GetSystemDir:string;
  872. var SysDir : array [0..Max_Path] of char;
  873. begin
  874.   GetSystemDirectory(SysDir,Max_Path);
  875.   Result:=AddBackSlash(String(SysDir));
  876. end; {GetSystemDir}
  877.  
  878. {$IFDEF SR_Delphi2_Up}
  879. function GetSystemFileDescription(FileName:string):string;
  880. var
  881.  SysIL : UInt;
  882.  Info  : TSHFileInfo;
  883. begin
  884.   SysIL:=SHGetFileInfo(PChar(FileName), 0, Info, SizeOf(TSHFileInfo), SHGFI_TYPENAME);
  885.   if SysIL<>0 then
  886.     Result:=Info.szTypeName
  887.   else
  888.     Result:='';
  889. end; {GetSystemFileDescr}
  890.  
  891. function GetSystemWorkArea:TRect;
  892. var PRect : ^TRect;
  893. begin
  894.   Result:=Rect(0, 0, 0, 0);
  895.   GetMem(PRect, SizeOf(TRect));
  896.   try
  897.     if SystemParametersInfo(SPI_GetWorkArea, 0, PRect, 0) then begin
  898.       Result:=PRect^;
  899.     end;
  900.   finally
  901.     FreeMem(PRect);
  902.   end;
  903. end; {GetSystemWorkArea}
  904. {$ENDIF}
  905.  
  906. function GetVersionNr(ExeName:string;BuildNr:boolean):string;
  907. var V1,V2,V3,V4 : Word;
  908. begin
  909.   if GetBuildInfo(ExeName, V1, V2, V3, V4) then begin
  910.     if BuildNr then
  911.       Result:=IntToStr(V1)+'.'+IntToStr(V2)+IntToStr(V3)+' (Build '+IntToStr(V4)+')'
  912.     else
  913.       Result:=IntToStr(V1)+'.'+IntToStr(V2)+IntToStr(V3);
  914.   end
  915.   else
  916.     Result:='';
  917. end; {GetVersionNr}
  918.  
  919. function GetWeekOfYear(ADate:TDateTime):byte;
  920. var Year,Month,Day : Word;
  921. begin
  922.   ADate:=ADate-((DayOfWeek(ADate)-FirstWeekDay+7) mod 7)+ 7-FirstWeekDate;
  923.   DecodeDate(ADate, Year, Month, Day);
  924.   Result:=(Trunc(ADate-EncodeDate(Year,1,1)) div 7)+1;
  925. end; {GetWeekOfYear}
  926.  
  927. function GetWeeksPerYear(AYear:word):byte;
  928. var AWeek : byte;
  929. begin
  930.   AWeek:=GetWeekOfYear(EncodeDate(AYear,12,31));
  931.   if AWeek=1 then
  932.     Result:=52
  933.   else
  934.     Result:=AWeek;
  935. end; {GetWeeksPerYear}
  936.  
  937. function GetWindowsDir:string;
  938. var WinDir : array [0..Max_Path] of char;
  939. begin
  940.   GetWindowsDirectory(WinDir,Max_Path);
  941.   Result:=AddBackSlash(String(WinDir));
  942. end; {GetWindowsDir}
  943.  
  944. {$IFDEF SR_Delphi2_Up}
  945. function GetWindowState(WHandle:HWnd):integer;
  946. {$IFNDEF SR_Delphi4_Up}
  947. var PPlcmnt : TWindowPlacement;
  948. {$ELSE}
  949. var PPlcmnt : WindowPlacement;
  950. {$ENDIF}
  951.  
  952.   { Die Rⁿckgabewerte der Funktion entsprechen folgenden Konstanten
  953.     aus der Unit Windows.pas:
  954.  
  955.     SW_HIDE = 0;
  956.     SW_SHOWNORMAL = 1;
  957.     SW_SHOWMINIMIZED = 2;
  958.     SW_SHOWMAXIMIZED = 3;
  959.     SW_SHOWNOACTIVATE = 4;
  960.     SW_SHOW = 5;
  961.     SW_MINIMIZE = 6;
  962.     SW_SHOWMINNOACTIVE = 7;
  963.     SW_SHOWNA = 8;
  964.     SW_RESTORE = 9;
  965.     SW_SHOWDEFAULT = 10; }
  966.  
  967. begin
  968.   {$IFNDEF SR_Delphi4_Up}
  969.   PPlcmnt.Length:=SizeOf(TWindowPlacement);
  970.   {$ELSE}
  971.   PPlcmnt.Length:=SizeOf(WindowPlacement);
  972.   {$ENDIF}
  973.   if GetWindowPlacement(WHandle, @PPlcmnt) then
  974.     Result:=PPlcmnt.ShowCmd
  975.   else
  976.     Result:=-1;
  977. end; {GetWindowState}
  978.  
  979. function GetWinUsername:string;
  980. var UName : PChar;
  981.     USize : DWord;
  982. begin
  983.   USize:=Max_Path;
  984.   UName:=StrAlloc(USize);
  985.   try
  986.     GetUserName(UName,USize);
  987.     Result:=string(UName);
  988.   finally
  989.     StrDispose(UName);
  990.   end;
  991. end; {GetWinUsername}
  992. {$ENDIF}
  993.  
  994. function GetYearFromDate(ADate:TDateTime):word;
  995. var Y,M,D : word;
  996. begin
  997.   try
  998.     Decodedate(ADate, Y, M, D);
  999.   except
  1000.     Y:=0;
  1001.   end;
  1002.   Result:=Y;
  1003. end; {GetYearFromDate}
  1004.  
  1005. {$IFDEF SR_Delphi2_Up}
  1006. procedure InitLocale;
  1007. var SystemTime: TSystemTime;
  1008.  
  1009.   function GetLocaleInt(AInfo:LCTYPE):Integer;
  1010.   var
  1011.     Buffer: array[0..1] of Char;
  1012.   begin
  1013.     if GetLocaleInfo(GetThreadLocale, AInfo, Buffer, 2) > 0 then
  1014.       Result:=Ord(Buffer[0])-Ord('0')
  1015.     else
  1016.       Result:=-1;
  1017.   end; {GetLocaleInt}
  1018.  
  1019. begin
  1020.   LocaleIDate :=GetLocaleInt(LOCALE_IDATE);
  1021.   LocaleILDate:=GetLocaleInt(LOCALE_ILDATE);
  1022.   GetLocalTime(SystemTime);
  1023.   CurrentYear2Digit:=SystemTime.wYear mod 100;
  1024.   CurrentCentury:=SystemTime.wYear-CurrentYear2Digit;
  1025. end; {InitLocale}
  1026. {$ENDIF}
  1027.  
  1028. function IntToStrFixed(IntValue:integer;OutDigits:byte):string;
  1029. begin
  1030.   try
  1031.     Result:=IntToStr(Abs(IntValue));
  1032.     while (length(Result)<OutDigits) do
  1033.       Result:='0'+Result;
  1034.     if (IntValue<0) then
  1035.       Result:='-'+Result;
  1036.   except
  1037.     Result:='';
  1038.   end;
  1039. end; {IntToStrFixed}
  1040.  
  1041. {$IFNDEF SR_Delphi3_Up}
  1042. function IsLeapYear(AYear:integer):boolean;
  1043. begin
  1044.   Result:=(AYear mod 4=0) and ((AYear mod 100<>0) or (AYear mod 400=0));
  1045. end; {IsLeapYear}
  1046. {$ENDIF}
  1047.  
  1048. function IsSummertime(ADate:TDateTime):boolean;
  1049. { Ermmittelt, ob ein Datum in der Sommerzeit liegt }
  1050. var AYear,
  1051.     AMonth,
  1052.     ADay   : word;
  1053.     Beginn,
  1054.     Ende   : TDateTime;
  1055. begin
  1056.   try
  1057.     DecodeDate(ADate, AYear, AMonth, ADay);
  1058.     if AYear<1980 then
  1059.       { Keine Sommerzeit vor 1980 }
  1060.       Result:=false
  1061.     else begin
  1062.       { Beginn der Sommerzeit: }
  1063.       Beginn:=EncodeDate(AYear, 3, 31);
  1064.       while DayOfWeek(Beginn)<>1 do
  1065.         Beginn:=Beginn-1;
  1066.       { Ende der Sommerzeit: }
  1067.       if AYear<=1995 then
  1068.         { bis 1995: letzter So im September }
  1069.         Ende:=EncodeDate(AYear, 9, 30)
  1070.       else
  1071.         { ab 1996: letzter So im Oktober }
  1072.         Ende:=EncodeDate(AYear, 10, 31);
  1073.       while DayOfWeek(Ende)<>1 do
  1074.         Ende:=Ende-1;
  1075.       Result:=(ADate>=Beginn) and (ADate<Ende);
  1076.     end;
  1077.   except
  1078.     Result:=false;
  1079.   end;
  1080. end; {IsSummertime}
  1081.  
  1082. {$IFDEF SR_Delphi2_Up}
  1083. function IsWindowsNT:boolean;
  1084. var OsVinfo : TOSVERSIONINFO;
  1085. begin
  1086.   ZeroMemory(@OsVinfo,sizeOf(OsVinfo));
  1087.   OsVinfo.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
  1088.   if GetVersionEx(OsVinfo) then
  1089.     Result:=OsVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT
  1090.   else
  1091.     Result:=false;
  1092. end; {IsWindowsNT}
  1093. {$ENDIF}
  1094.  
  1095. {$IFNDEF SR_Delphi3_Up}
  1096. function LastDelimiter(AChar:char;AText:string):integer;
  1097. var i : integer;
  1098. begin
  1099.   Result:=0;
  1100.   if length(AText)=0 then
  1101.     Exit;
  1102.   for i:=length(AText) downto 1 do begin
  1103.     if AText[i]=AChar then begin
  1104.       Result:=i;
  1105.       Exit;
  1106.     end;
  1107.   end;
  1108. end;
  1109. {$ENDIF}
  1110.  
  1111. function PosN(const AText,S:string;N:integer):integer;
  1112. var Temp : string;
  1113.     P    : integer;
  1114. begin
  1115.   if N>1 then begin
  1116.     Temp:=copy(S, N, length(S)-N+1);
  1117.     dec(N);
  1118.   end
  1119.   else
  1120.     Temp:=S;
  1121.   P:=Pos(AText, Temp);
  1122.   if P>0 then
  1123.     Result:=P+N
  1124.   else
  1125.     Result:=0;
  1126. end; {PosN}
  1127.  
  1128. function ReverseString(AText:string):string;
  1129. var i : byte;
  1130. begin
  1131.   Result:='';
  1132.   for i:=length(AText) downto 1 do
  1133.     Result:=Result+AText[i];
  1134. end; {ReverseString}
  1135.  
  1136. function RGBToStr(RGBColor:integer):string;
  1137. var ColText : string;
  1138. begin
  1139.   ColText:=IntToHex(RGBColor,6);
  1140.   Result:=copy(ColText,5,2)+copy(ColText,3,2)+copy(ColText,1,2);
  1141. end; {RGBToStr}
  1142.  
  1143. {$IFDEF SR_Delphi2_Up}
  1144. procedure SendKeys(AText:string);
  1145. var i : integer;
  1146.     w : word;
  1147. begin
  1148.   for i:=1 to Length(AText) do begin
  1149.     w:=VkKeyScan(AText[i]);
  1150.     if ((HiByte(w)<>$FF) and (LoByte(w)<>$FF)) then begin
  1151.       {If the key requires the shift key down - hold it down}
  1152.       if HiByte(w) and 1 = 1 then
  1153.         SimulateKeyDown(VK_SHIFT);
  1154.       {Send the VK_KEY}
  1155.       SimulateKeystroke(LoByte(w), 0);
  1156.       {If the key required the shift key down - release it}
  1157.       if HiByte(w) and 1 = 1 then
  1158.         SimulateKeyUp(VK_SHIFT);
  1159.     end;
  1160.   end;
  1161. end; {SendKeys}
  1162. {$ENDIF}
  1163.  
  1164. {$IFDEF SR_Delphi1}
  1165. procedure SetFileDate(FName:string;FDate:LongInt);
  1166. var F : TFileStream;
  1167. begin
  1168.   try
  1169.     F:=TFileStream.Create(FName,fmOpenWrite);
  1170.     FileSetDate(F.Handle,FDate);
  1171.   finally
  1172.     F.Free;
  1173.   end;
  1174. end;
  1175. {$ELSE}
  1176. function SetFileDate(FName:string;FDate:Integer):boolean;
  1177. var F : TFileStream;
  1178. begin
  1179.   try
  1180.     F:=TFileStream.Create(FName,fmOpenWrite);
  1181.     Result:=(FileSetDate(F.Handle,FDate)=0);
  1182.     F.Free;
  1183.   except
  1184.     Result:=false;
  1185.   end;
  1186. end; {SetFileDate}
  1187. {$ENDIF}
  1188.  
  1189. {$IFDEF SR_Delphi2_Up}
  1190. procedure SimulateKeyDown(Key : byte);
  1191. begin
  1192.   Keybd_Event(Key, 0, 0, 0);
  1193. end; {SimulateKeyDown}
  1194.  
  1195. procedure SimulateKeystroke(Key:byte; extra:DWORD);
  1196. begin
  1197.   Keybd_Event(Key, extra, 0, 0);
  1198.   Keybd_Event(Key, extra, KEYEVENTF_KEYUP, 0);
  1199. end; {SimulateKeystroke}
  1200.  
  1201. procedure SimulateKeyUp(Key : byte);
  1202. begin
  1203.   Keybd_Event(Key, 0, KEYEVENTF_KEYUP, 0);
  1204. end; {SimulateKeyUp}
  1205. {$ENDIF}
  1206.  
  1207. function StripForbiddenChars(AText:string):string;
  1208. var i : integer;
  1209. begin
  1210.   if length(AText)>0 then
  1211.     for i:=length(AText) downto 1 do
  1212.       {$IFDEF SR_Delphi1}
  1213.       if AText[i] in ShortForbiddenChars then
  1214.         delete(AText,i,1);
  1215.       {$ELSE}
  1216.       if AText[i] in LongForbiddenChars then
  1217.         delete(AText,i,1);
  1218.       {$ENDIF}
  1219.   Result:=AText;
  1220. end; {StripForbiddenChars}
  1221.  
  1222. function StrToDateDef(S:string;Def:TDateTime):TDateTime;
  1223. begin
  1224.   try
  1225.     Result:=StrToDate(S);
  1226.   except
  1227.     Result:=Def;
  1228.   end;
  1229. end; {StrToDateDef}
  1230.  
  1231. function StrToDateTimeDef(S:string;Def:TDateTime):TDateTime;
  1232. begin
  1233.   try
  1234.     Result:=StrToDateTime(S);
  1235.   except
  1236.     Result:=Def;
  1237.   end;
  1238. end; {StrToDateTimeDef}
  1239.  
  1240. function StrToFloatDef(S:string;Def:extended):extended;
  1241. begin
  1242.   try
  1243.     Result:=StrToFloat(S);
  1244.   except
  1245.     Result:=Def;
  1246.   end;
  1247. end; {StrToFloatDef}
  1248.  
  1249. function StrToTimeDef(S:string;Def:TDateTime):TDateTime;
  1250. begin
  1251.   try
  1252.     Result:=StrToTime(S);
  1253.   except
  1254.     Result:=Def;
  1255.   end;
  1256. end; {StrToTimeDef}
  1257.  
  1258. function TimeToStrDef(ADate:TDateTime;Default:string):string;
  1259. begin
  1260.   try
  1261.     Result:=TimeToStr(ADate);
  1262.   except
  1263.     Result:=Default;
  1264.   end;
  1265. end; {TimeToStrDef}
  1266.  
  1267. {$IFDEF SR_Delphi1}
  1268. function Trim(const AText:string):string;
  1269. var i,L: Integer;
  1270. begin
  1271.   L:=length(AText);
  1272.   i:=1;
  1273.   while (i<=L) and (AText[i]<=' ') do
  1274.     inc(i);
  1275.   if i>L then
  1276.     Result:=''
  1277.   else begin
  1278.     while AText[L]<=' ' do
  1279.       dec(L);
  1280.     Result:=Copy(AText, i, L-i+1);
  1281.   end;
  1282. end; {Trim}
  1283. {$ENDIF}
  1284.  
  1285. function TrimChars(const AChar:char;const AText:string):string;
  1286. var i,L: Integer;
  1287. begin
  1288.   L:=length(AText);
  1289.   i:=1;
  1290.   while (i<=L) and (AText[i]=AChar) do
  1291.     inc(i);
  1292.   if i>L then
  1293.     Result:=''
  1294.   else begin
  1295.     while AText[L]=AChar do
  1296.       dec(L);
  1297.     Result:=Copy(AText, i, L-i+1);
  1298.   end;
  1299. end; {TrimChars}
  1300.  
  1301. function ValidFileName(DName:string):boolean;
  1302. var i : integer;
  1303. begin
  1304.   Result:=true;
  1305.   for i:=1 to length(DName) do
  1306.     {$IFDEF SR_Delphi1}
  1307.     if DName[i] in ShortForbiddenChars then
  1308.       Result:=false;
  1309.     {$ELSE}
  1310.     if DName[i] in LongForbiddenChars then
  1311.       Result:=false;
  1312.     {$ENDIF}
  1313. end; {ValidFileName}
  1314.  
  1315. {$IFDEF SR_Delphi1}
  1316. initialization
  1317.  
  1318. FirstWeekDay  := 2;  { Wochentag, mit dem die Woche beginnt
  1319.                        (siehe Delphi-Wochentage)
  1320.                        2 : Montag (nach DIN 1355) }
  1321. FirstWeekDate := 4;  { 1 : Beginnt am ersten Januar
  1322.                        4 : Erste-4 Tage-Woche (nach DIN 1355)
  1323.                        7 : Erste volle Woche }
  1324. {$ENDIF}
  1325.  
  1326. end.
  1327.