/[projects]/dao/DelphiScanner/Utils.pas

Diff of /dao/DelphiScanner/Utils.pas

Parent Directory | Revision Log | View Patch Patch

-revision 2682 by torben,
Wed Aug 26 19:52:38 2015 UTC
+revision 2695 by torben,
Thu Sep  3 14:40:49 2015 UTC
 Line 3 
 unit Utils;
  interface
  uses
    Controls,
-   Graphics //TColor
+   Graphics, //TColor
+   IniFiles,
+   Windows //TFileTime
    ;
  type
-Line 20 
 type
+Line 22 
 type
      class function TColorToHex(Color : TColor) : string;
      class function HexToTColor(sColor : string) : TColor;
+     class function AdobeReaderExists(): Boolean;
+     class function Sto_GetFmtFileVersion(const FileName: String = ''): String;
+     class function CheckUrl(url:string): boolean;
+     class function FileTime2DateTime(FileTime: TFileTime): TDateTime;
-Line 29 
 implementation
+Line 39 
 implementation
  uses StrUtils,
    Types, //TRect ,
-   Windows,
    Messages,
-   SysUtils //IntToStr etc
+   SysUtils, //IntToStr etc
+   Registry,
+   wininet   //CheckUrl
    ;
  {
-Line 161 
 begin
+Line 173 
 begin
  end;
+ class function TUtils.AdobeReaderExists(): Boolean;
+ var
+   AReg: TRegistry;
+ begin
+   result:= false;
+   AReg := TRegistry.Create;
+   AReg.RootKey := HKEY_LOCAL_MACHINE;
+   if AReg.KeyExists('\SOFTWARE\Adobe\Acrobat Reader') then
+     result:= True;
+   AReg.Free;
+ end;
+ /// <summary>
+ ///   This function reads the file resource of "FileName" and returns
+ ///   the version number as formatted text.</summary>
+ /// <example>
+ ///   Sto_GetFmtFileVersion() = '4.13.128.0'
+ ///   Sto_GetFmtFileVersion('', '%.2d-%.2d-%.2d') = '04-13-128'
+ /// </example>
+ /// <remarks>If "Fmt" is invalid, the function may raise an
+ ///   EConvertError exception.</remarks>
+ /// <param name="FileName">Full path to exe or dll. If an empty
+ ///   string is passed, the function uses the filename of the
+ ///   running exe or dll.</param>
+ /// <param name="Fmt">Format string, you can use at most four integer
+ ///   values.</param>
+ /// <returns>Formatted version number of file, '' if no version
+ ///   resource found.</returns>
+ class function TUtils.Sto_GetFmtFileVersion(const FileName: String = ''): String;
+ var
+   sFileName: String;
+   iBufferSize: DWORD;
+   iDummy: DWORD;
+   pBuffer: Pointer;
+   pFileInfo: Pointer;
+   iVer: array[1..4] of Integer;
+ begin
+   // set default value
+   Result := '';
+   // get filename of exe/dll if no filename is specified
+   sFileName := Trim(FileName);
+   if (sFileName = '') then
+     sFileName := GetModuleName(HInstance);
+   // get size of version info (0 if no version info exists)
+   iBufferSize := GetFileVersionInfoSize(PChar(sFileName), iDummy);
+   if (iBufferSize > 0) then
+   begin
+     GetMem(pBuffer, iBufferSize);
+     try
+     // get fixed file info (language independent)
+     GetFileVersionInfo(PChar(sFileName), 0, iBufferSize, pBuffer);
+     VerQueryValue(pBuffer, '\', pFileInfo, iDummy);
+     // read version blocks
+     iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
+     iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
+     iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
+     iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
+     finally
+       FreeMem(pBuffer);
+     end;
+     // format result string
+     Result := Format('%d.%d.%d.%d', [iVer[1], iVer[2], iVer[3], iVer[4]]);
+   end;
+ end;
+ class function TUtils.CheckUrl(url:string):boolean;
+ var
+   hSession, hfile: hInternet;
+   dwindex,dwcodelen :dword;
+   dwcode:array[1..20] of char;
+   res : pchar;
+ begin
+   if pos('http://',lowercase(url))=0 then
+     url := 'http://'+url;
+   Result := false;
+   hSession := InternetOpen('InetURL:/1.0',
+                             INTERNET_OPEN_TYPE_PRECONFIG,
+                             nil,
+                             nil,
+);
+   if assigned(hsession) then
+   begin
+     hfile := InternetOpenUrl(hsession,
+                              pchar(url),
+                              nil,
+,
+                              INTERNET_FLAG_RELOAD,
+);
+     dwIndex := 0;
+     dwCodeLen := 10;
+     HttpQueryInfo(hfile,
+                   HTTP_QUERY_STATUS_CODE,
+                   @dwcode,
+                   dwcodeLen,
+                   dwIndex);
+     res := pchar(@dwcode);
+     result:= (res ='200') or (res ='302');
+     if assigned(hfile) then
+       InternetCloseHandle(hfile);
+     InternetCloseHandle(hsession);
+   end;
+ end;
+ class function TUtils.FileTime2DateTime(FileTime: TFileTime): TDateTime;
+ var
+    LocalFileTime: TFileTime;
+    SystemTime: TSystemTime;
+ begin
+    FileTimeToLocalFileTime(FileTime, LocalFileTime) ;
+    FileTimeToSystemTime(LocalFileTime, SystemTime) ;
+    Result := SystemTimeToDateTime(SystemTime) ;
+ end;
  end.

 Legend:



Removed from v.2682
 


changed lines


 
Added in v.2695
 Legend:



Removed from v.2682
 


changed lines


 
Added in v.2695
-Removed from v.2682
+Added in v.2695

	ViewVC Help
Powered by ViewVC 1.1.20