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

Diff of /dao/DelphiScanner/Main.pas

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

revision 2693 by torben, Thu Sep 3 14:27:21 2015 UTC revision 2695 by torben, Thu Sep 3 14:40:49 2015 UTC
# Line 99  type Line 99  type
99    function GetCurrentPrinterHandle() : THandle;    function GetCurrentPrinterHandle() : THandle;
100    function SavePChar(p: PChar): PChar;    function SavePChar(p: PChar): PChar;
101    
   function FileTime2DateTime(FileTime: TFileTime): TDateTime;  
   function CheckUrl(url:string):boolean;  
   
102    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
103    procedure StartScreen();    procedure StartScreen();
104    procedure InitScreen();    procedure InitScreen();
# Line 2655  begin Line 2652  begin
2652          // Tjekker UrlNormal          // Tjekker UrlNormal
2653          if PanelValg1.Enabled = true then          if PanelValg1.Enabled = true then
2654          begin          begin
2655            if CheckUrl(UrlNormal) then            if TUtils.CheckUrl(UrlNormal) then
2656            begin            begin
2657              logTekst := 'UrlNormal accepteret: ' + UrlNormal;              logTekst := 'UrlNormal accepteret: ' + UrlNormal;
2658              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2684  begin Line 2681  begin
2681          // Tjekker UrlReturDAO          // Tjekker UrlReturDAO
2682          if PanelValg2.Enabled = true then          if PanelValg2.Enabled = true then
2683          begin          begin
2684            if CheckUrl(UrlReturDAO) then            if TUtils.CheckUrl(UrlReturDAO) then
2685            begin            begin
2686              logTekst := 'UrlReturDAO accepteret: ' + UrlReturDAO;              logTekst := 'UrlReturDAO accepteret: ' + UrlReturDAO;
2687              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2712  begin Line 2709  begin
2709          // Tjekker UrlReturBoghandler          // Tjekker UrlReturBoghandler
2710          if PanelValg3.Enabled = true then          if PanelValg3.Enabled = true then
2711          begin          begin
2712            if CheckUrl(UrlReturBoghandler) then            if TUtils.CheckUrl(UrlReturBoghandler) then
2713            begin            begin
2714              logTekst := 'UrlReturBoghandler accepteret: ' + UrlReturBoghandler;              logTekst := 'UrlReturBoghandler accepteret: ' + UrlReturBoghandler;
2715              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2740  begin Line 2737  begin
2737          // Tjekker UrlBudlevering          // Tjekker UrlBudlevering
2738          if PanelValg4.Enabled = true then          if PanelValg4.Enabled = true then
2739          begin          begin
2740            if CheckUrl(UrlBudlevering) then            if TUtils.CheckUrl(UrlBudlevering) then
2741            begin            begin
2742              logTekst := 'UrlBudlevering accepteret: ' + UrlBudlevering;              logTekst := 'UrlBudlevering accepteret: ' + UrlBudlevering;
2743              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2768  begin Line 2765  begin
2765          // Tjekker UrlPakkeshoplevering          // Tjekker UrlPakkeshoplevering
2766          if PanelValg5.Enabled = true then          if PanelValg5.Enabled = true then
2767          begin          begin
2768            if CheckUrl(UrlPakkeshoplevering) then            if TUtils.CheckUrl(UrlPakkeshoplevering) then
2769            begin            begin
2770              logTekst := 'UrlPakkeshoplevering accepteret: ' + UrlPakkeshoplevering;              logTekst := 'UrlPakkeshoplevering accepteret: ' + UrlPakkeshoplevering;
2771              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2796  begin Line 2793  begin
2793          // Tjekker UrlReturPakkeshop          // Tjekker UrlReturPakkeshop
2794          if PanelValg6.Enabled = true then          if PanelValg6.Enabled = true then
2795          begin          begin
2796            if CheckUrl(UrlReturPakkeshop) then            if TUtils.CheckUrl(UrlReturPakkeshop) then
2797            begin            begin
2798              logTekst := 'UrlReturPakkeshop accepteret: ' + UrlReturPakkeshop;              logTekst := 'UrlReturPakkeshop accepteret: ' + UrlReturPakkeshop;
2799              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2825  begin Line 2822  begin
2822          if (PanelValg1.Enabled = true)          if (PanelValg1.Enabled = true)
2823          or (PanelValg4.Enabled = true) then          or (PanelValg4.Enabled = true) then
2824          begin          begin
2825            if CheckUrl(UrlManglendeScanninger) then            if TUtils.CheckUrl(UrlManglendeScanninger) then
2826            begin            begin
2827              logTekst := 'UrlManglendeScanninger accepteret: ' + UrlManglendeScanninger;              logTekst := 'UrlManglendeScanninger accepteret: ' + UrlManglendeScanninger;
2828              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2853  begin Line 2850  begin
2850          // Tjekker UrlPakkeshopManglendeScanninger          // Tjekker UrlPakkeshopManglendeScanninger
2851          if PanelValg5.Enabled = true then          if PanelValg5.Enabled = true then
2852          begin          begin
2853            if CheckUrl(UrlPakkeshopManglendeScanninger) then            if TUtils.CheckUrl(UrlPakkeshopManglendeScanninger) then
2854            begin            begin
2855              logTekst := 'UrlPakkeshopManglendeScanninger accepteret: ' + UrlPakkeshopManglendeScanninger;              logTekst := 'UrlPakkeshopManglendeScanninger accepteret: ' + UrlPakkeshopManglendeScanninger;
2856              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2881  begin Line 2878  begin
2878          // Tjekker UrlPakkeshopManglendeReturScanninger          // Tjekker UrlPakkeshopManglendeReturScanninger
2879          if PanelValg6.Enabled = true then          if PanelValg6.Enabled = true then
2880          begin          begin
2881            if CheckUrl(UrlPakkeshopManglendeReturScanninger) then            if TUtils.CheckUrl(UrlPakkeshopManglendeReturScanninger) then
2882            begin            begin
2883              logTekst := 'UrlPakkeshopManglendeReturScanninger accepteret: ' + UrlPakkeshopManglendeReturScanninger;              logTekst := 'UrlPakkeshopManglendeReturScanninger accepteret: ' + UrlPakkeshopManglendeReturScanninger;
2884              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2909  begin Line 2906  begin
2906         // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger         // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger
2907          if PanelValg7.Enabled = true then          if PanelValg7.Enabled = true then
2908          begin          begin
2909            if CheckUrl(UrlIndleveringsPakke) then            if TUtils.CheckUrl(UrlIndleveringsPakke) then
2910            begin            begin
2911              logTekst := 'UrlIndleveringsPakke accepteret: ' + UrlIndleveringsPakke;              logTekst := 'UrlIndleveringsPakke accepteret: ' + UrlIndleveringsPakke;
2912              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2933  begin Line 2930  begin
2930              end;              end;
2931            end;            end;
2932    
2933            if CheckUrl(UrlIndleveringsPakkeManglendeScanninger) then            if TUtils.CheckUrl(UrlIndleveringsPakkeManglendeScanninger) then
2934            begin            begin
2935              logTekst := 'UrlIndleveringsPakkeManglendeScanninger accepteret: ' + UrlIndleveringsPakkeManglendeScanninger;              logTekst := 'UrlIndleveringsPakkeManglendeScanninger accepteret: ' + UrlIndleveringsPakkeManglendeScanninger;
2936              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2961  begin Line 2958  begin
2958          // Tjekker UrlEKLoverforsel          // Tjekker UrlEKLoverforsel
2959          if PanelValg1.Enabled = true then          if PanelValg1.Enabled = true then
2960          begin          begin
2961            if CheckUrl(UrlEKLoverforsel) then            if TUtils.CheckUrl(UrlEKLoverforsel) then
2962            begin            begin
2963              logTekst := 'UrlEKLoverforsel accepteret: ' + UrlEKLoverforsel;              logTekst := 'UrlEKLoverforsel accepteret: ' + UrlEKLoverforsel;
2964              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2990  begin Line 2987  begin
2987          // Tjekker UrlEKLoverforselPakkeshop          // Tjekker UrlEKLoverforselPakkeshop
2988          if PanelValg5.Enabled = true then          if PanelValg5.Enabled = true then
2989          begin          begin
2990            if CheckUrl(UrlEKLoverforselPakkeshop) then            if TUtils.CheckUrl(UrlEKLoverforselPakkeshop) then
2991            begin            begin
2992              logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;              logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;
2993              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 3017  begin Line 3014  begin
3014    
3015    
3016          // Tjekker UrlFindPakketype          // Tjekker UrlFindPakketype
3017          if CheckUrl(UrlFindPakketype) then          if TUtils.CheckUrl(UrlFindPakketype) then
3018          begin          begin
3019            logTekst := 'UrlFindPakketype accepteret: ' + UrlFindPakketype;            logTekst := 'UrlFindPakketype accepteret: ' + UrlFindPakketype;
3020            SkrivScanningLogFil(logTekst);            SkrivScanningLogFil(logTekst);
# Line 3042  begin Line 3039  begin
3039          end;          end;
3040    
3041          // Tjekker UrlSendPrograminfo          // Tjekker UrlSendPrograminfo
3042          if CheckUrl(UrlSendPrograminfo) then          if TUtils.CheckUrl(UrlSendPrograminfo) then
3043          begin          begin
3044            logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;            logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;
3045            SkrivScanningLogFil(logTekst);            SkrivScanningLogFil(logTekst);
# Line 3079  begin Line 3076  begin
3076    
3077  end;  end;
3078    
 function TMainForm.FileTime2DateTime(FileTime: TFileTime): TDateTime;  
 var  
    LocalFileTime: TFileTime;  
    SystemTime: TSystemTime;  
 begin  
    FileTimeToLocalFileTime(FileTime, LocalFileTime) ;  
    FileTimeToSystemTime(LocalFileTime, SystemTime) ;  
    Result := SystemTimeToDateTime(SystemTime) ;  
 end;  
   
3079  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);
3080  var  var
3081    SR: TSearchRec;    SR: TSearchRec;
# Line 3108  begin Line 3095  begin
3095    
3096          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3097          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3098          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := TUtils.FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
3099          // Selvom creation date godt kan være forskellig fra modified date,          // Selvom creation date godt kan være forskellig fra modified date,
3100          // skal vi alligevel altid tjekke filens alder ud fra modified date          // skal vi alligevel altid tjekke filens alder ud fra modified date
3101          // (ændring den kan ligge både før og efter oprettelse, hvis filerne er flyttet eller ændret manuelt)          // (ændring den kan ligge både før og efter oprettelse, hvis filerne er flyttet eller ændret manuelt)
# Line 5355  end; Line 5342  end;
5342    
5343    
5344    
 function TMainForm.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,  
                             0);  
   if assigned(hsession) then  
   begin  
     hfile := InternetOpenUrl(hsession,  
                              pchar(url),  
                              nil,  
                              0,  
                              INTERNET_FLAG_RELOAD,  
                              0);  
     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;  
5345    
 end;  
5346    
5347    
5348  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
Legend:
Removed from v.2693  
changed lines
  Added in v.2695
  ViewVC Help
Powered by ViewVC 1.1.20