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

Diff of /dao/DelphiScanner/Utils.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 2682 by torben, Wed Aug 26 19:52:38 2015 UTC revision 2694 by torben, Thu Sep 3 14:31:39 2015 UTC
# Line 20  type Line 20  type
20      class function TColorToHex(Color : TColor) : string;      class function TColorToHex(Color : TColor) : string;
21      class function HexToTColor(sColor : string) : TColor;      class function HexToTColor(sColor : string) : TColor;
22    
23        class function AdobeReaderExists(): Boolean;
24    
25        class function Sto_GetFmtFileVersion(const FileName: String = ''): String;
26    
27        class function CheckUrl(url:string): boolean;
28    
29    
30    
31    
# Line 31  uses StrUtils, Line 37  uses StrUtils,
37    Types, //TRect ,    Types, //TRect ,
38    Windows,    Windows,
39    Messages,    Messages,
40    SysUtils //IntToStr etc    SysUtils, //IntToStr etc
41      Registry,
42      wininet   //CheckUrl
43    
44    ;    ;
45    
46  {  {
# Line 161  begin Line 170  begin
170  end;  end;
171    
172    
173    class function TUtils.AdobeReaderExists(): Boolean;
174    var
175      AReg: TRegistry;
176    begin
177      result:= false;
178      AReg := TRegistry.Create;
179      AReg.RootKey := HKEY_LOCAL_MACHINE;
180      if AReg.KeyExists('\SOFTWARE\Adobe\Acrobat Reader') then
181        result:= True;
182      AReg.Free;
183    end;
184    
185    
186    /// <summary>
187    ///   This function reads the file resource of "FileName" and returns
188    ///   the version number as formatted text.</summary>
189    /// <example>
190    ///   Sto_GetFmtFileVersion() = '4.13.128.0'
191    ///   Sto_GetFmtFileVersion('', '%.2d-%.2d-%.2d') = '04-13-128'
192    /// </example>
193    /// <remarks>If "Fmt" is invalid, the function may raise an
194    ///   EConvertError exception.</remarks>
195    /// <param name="FileName">Full path to exe or dll. If an empty
196    ///   string is passed, the function uses the filename of the
197    ///   running exe or dll.</param>
198    /// <param name="Fmt">Format string, you can use at most four integer
199    ///   values.</param>
200    /// <returns>Formatted version number of file, '' if no version
201    ///   resource found.</returns>
202    class function TUtils.Sto_GetFmtFileVersion(const FileName: String = ''): String;
203    var
204      sFileName: String;
205      iBufferSize: DWORD;
206      iDummy: DWORD;
207      pBuffer: Pointer;
208      pFileInfo: Pointer;
209      iVer: array[1..4] of Integer;
210    begin
211      // set default value
212      Result := '';
213      // get filename of exe/dll if no filename is specified
214      sFileName := Trim(FileName);
215      if (sFileName = '') then
216        sFileName := GetModuleName(HInstance);
217      // get size of version info (0 if no version info exists)
218      iBufferSize := GetFileVersionInfoSize(PChar(sFileName), iDummy);
219      if (iBufferSize > 0) then
220      begin
221        GetMem(pBuffer, iBufferSize);
222        try
223        // get fixed file info (language independent)
224        GetFileVersionInfo(PChar(sFileName), 0, iBufferSize, pBuffer);
225        VerQueryValue(pBuffer, '\', pFileInfo, iDummy);
226        // read version blocks
227        iVer[1] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
228        iVer[2] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionMS);
229        iVer[3] := HiWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
230        iVer[4] := LoWord(PVSFixedFileInfo(pFileInfo)^.dwFileVersionLS);
231        finally
232          FreeMem(pBuffer);
233        end;
234    
235        // format result string
236        Result := Format('%d.%d.%d.%d', [iVer[1], iVer[2], iVer[3], iVer[4]]);
237    
238      end;
239    end;
240    
241    
242    class function TUtils.CheckUrl(url:string):boolean;
243    var
244      hSession, hfile: hInternet;
245      dwindex,dwcodelen :dword;
246      dwcode:array[1..20] of char;
247      res : pchar;
248    begin
249      if pos('http://',lowercase(url))=0 then
250        url := 'http://'+url;
251      Result := false;
252      hSession := InternetOpen('InetURL:/1.0',
253                                INTERNET_OPEN_TYPE_PRECONFIG,
254                                nil,
255                                nil,
256                                0);
257      if assigned(hsession) then
258      begin
259        hfile := InternetOpenUrl(hsession,
260                                 pchar(url),
261                                 nil,
262                                 0,
263                                 INTERNET_FLAG_RELOAD,
264                                 0);
265        dwIndex := 0;
266        dwCodeLen := 10;
267        HttpQueryInfo(hfile,
268                      HTTP_QUERY_STATUS_CODE,
269                      @dwcode,
270                      dwcodeLen,
271                      dwIndex);
272        res := pchar(@dwcode);
273        result:= (res ='200') or (res ='302');
274        if assigned(hfile) then
275          InternetCloseHandle(hfile);
276        InternetCloseHandle(hsession);
277      end;
278    
279    end;
280    
281  end.  end.

Legend:
Removed from v.2682  
changed lines
  Added in v.2694

  ViewVC Help
Powered by ViewVC 1.1.20