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