/[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 2694 by torben, Thu Sep 3 14:31:39 2015 UTC
# Line 100  type Line 100  type
100    function SavePChar(p: PChar): PChar;    function SavePChar(p: PChar): PChar;
101    
102    function FileTime2DateTime(FileTime: TFileTime): TDateTime;    function FileTime2DateTime(FileTime: TFileTime): TDateTime;
   function CheckUrl(url:string):boolean;  
103    
104    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
105    procedure StartScreen();    procedure StartScreen();
# Line 2655  begin Line 2654  begin
2654          // Tjekker UrlNormal          // Tjekker UrlNormal
2655          if PanelValg1.Enabled = true then          if PanelValg1.Enabled = true then
2656          begin          begin
2657            if CheckUrl(UrlNormal) then            if TUtils.CheckUrl(UrlNormal) then
2658            begin            begin
2659              logTekst := 'UrlNormal accepteret: ' + UrlNormal;              logTekst := 'UrlNormal accepteret: ' + UrlNormal;
2660              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2684  begin Line 2683  begin
2683          // Tjekker UrlReturDAO          // Tjekker UrlReturDAO
2684          if PanelValg2.Enabled = true then          if PanelValg2.Enabled = true then
2685          begin          begin
2686            if CheckUrl(UrlReturDAO) then            if TUtils.CheckUrl(UrlReturDAO) then
2687            begin            begin
2688              logTekst := 'UrlReturDAO accepteret: ' + UrlReturDAO;              logTekst := 'UrlReturDAO accepteret: ' + UrlReturDAO;
2689              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2712  begin Line 2711  begin
2711          // Tjekker UrlReturBoghandler          // Tjekker UrlReturBoghandler
2712          if PanelValg3.Enabled = true then          if PanelValg3.Enabled = true then
2713          begin          begin
2714            if CheckUrl(UrlReturBoghandler) then            if TUtils.CheckUrl(UrlReturBoghandler) then
2715            begin            begin
2716              logTekst := 'UrlReturBoghandler accepteret: ' + UrlReturBoghandler;              logTekst := 'UrlReturBoghandler accepteret: ' + UrlReturBoghandler;
2717              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2740  begin Line 2739  begin
2739          // Tjekker UrlBudlevering          // Tjekker UrlBudlevering
2740          if PanelValg4.Enabled = true then          if PanelValg4.Enabled = true then
2741          begin          begin
2742            if CheckUrl(UrlBudlevering) then            if TUtils.CheckUrl(UrlBudlevering) then
2743            begin            begin
2744              logTekst := 'UrlBudlevering accepteret: ' + UrlBudlevering;              logTekst := 'UrlBudlevering accepteret: ' + UrlBudlevering;
2745              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2768  begin Line 2767  begin
2767          // Tjekker UrlPakkeshoplevering          // Tjekker UrlPakkeshoplevering
2768          if PanelValg5.Enabled = true then          if PanelValg5.Enabled = true then
2769          begin          begin
2770            if CheckUrl(UrlPakkeshoplevering) then            if TUtils.CheckUrl(UrlPakkeshoplevering) then
2771            begin            begin
2772              logTekst := 'UrlPakkeshoplevering accepteret: ' + UrlPakkeshoplevering;              logTekst := 'UrlPakkeshoplevering accepteret: ' + UrlPakkeshoplevering;
2773              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2796  begin Line 2795  begin
2795          // Tjekker UrlReturPakkeshop          // Tjekker UrlReturPakkeshop
2796          if PanelValg6.Enabled = true then          if PanelValg6.Enabled = true then
2797          begin          begin
2798            if CheckUrl(UrlReturPakkeshop) then            if TUtils.CheckUrl(UrlReturPakkeshop) then
2799            begin            begin
2800              logTekst := 'UrlReturPakkeshop accepteret: ' + UrlReturPakkeshop;              logTekst := 'UrlReturPakkeshop accepteret: ' + UrlReturPakkeshop;
2801              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2825  begin Line 2824  begin
2824          if (PanelValg1.Enabled = true)          if (PanelValg1.Enabled = true)
2825          or (PanelValg4.Enabled = true) then          or (PanelValg4.Enabled = true) then
2826          begin          begin
2827            if CheckUrl(UrlManglendeScanninger) then            if TUtils.CheckUrl(UrlManglendeScanninger) then
2828            begin            begin
2829              logTekst := 'UrlManglendeScanninger accepteret: ' + UrlManglendeScanninger;              logTekst := 'UrlManglendeScanninger accepteret: ' + UrlManglendeScanninger;
2830              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2853  begin Line 2852  begin
2852          // Tjekker UrlPakkeshopManglendeScanninger          // Tjekker UrlPakkeshopManglendeScanninger
2853          if PanelValg5.Enabled = true then          if PanelValg5.Enabled = true then
2854          begin          begin
2855            if CheckUrl(UrlPakkeshopManglendeScanninger) then            if TUtils.CheckUrl(UrlPakkeshopManglendeScanninger) then
2856            begin            begin
2857              logTekst := 'UrlPakkeshopManglendeScanninger accepteret: ' + UrlPakkeshopManglendeScanninger;              logTekst := 'UrlPakkeshopManglendeScanninger accepteret: ' + UrlPakkeshopManglendeScanninger;
2858              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2881  begin Line 2880  begin
2880          // Tjekker UrlPakkeshopManglendeReturScanninger          // Tjekker UrlPakkeshopManglendeReturScanninger
2881          if PanelValg6.Enabled = true then          if PanelValg6.Enabled = true then
2882          begin          begin
2883            if CheckUrl(UrlPakkeshopManglendeReturScanninger) then            if TUtils.CheckUrl(UrlPakkeshopManglendeReturScanninger) then
2884            begin            begin
2885              logTekst := 'UrlPakkeshopManglendeReturScanninger accepteret: ' + UrlPakkeshopManglendeReturScanninger;              logTekst := 'UrlPakkeshopManglendeReturScanninger accepteret: ' + UrlPakkeshopManglendeReturScanninger;
2886              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2909  begin Line 2908  begin
2908         // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger         // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger
2909          if PanelValg7.Enabled = true then          if PanelValg7.Enabled = true then
2910          begin          begin
2911            if CheckUrl(UrlIndleveringsPakke) then            if TUtils.CheckUrl(UrlIndleveringsPakke) then
2912            begin            begin
2913              logTekst := 'UrlIndleveringsPakke accepteret: ' + UrlIndleveringsPakke;              logTekst := 'UrlIndleveringsPakke accepteret: ' + UrlIndleveringsPakke;
2914              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2933  begin Line 2932  begin
2932              end;              end;
2933            end;            end;
2934    
2935            if CheckUrl(UrlIndleveringsPakkeManglendeScanninger) then            if TUtils.CheckUrl(UrlIndleveringsPakkeManglendeScanninger) then
2936            begin            begin
2937              logTekst := 'UrlIndleveringsPakkeManglendeScanninger accepteret: ' + UrlIndleveringsPakkeManglendeScanninger;              logTekst := 'UrlIndleveringsPakkeManglendeScanninger accepteret: ' + UrlIndleveringsPakkeManglendeScanninger;
2938              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2961  begin Line 2960  begin
2960          // Tjekker UrlEKLoverforsel          // Tjekker UrlEKLoverforsel
2961          if PanelValg1.Enabled = true then          if PanelValg1.Enabled = true then
2962          begin          begin
2963            if CheckUrl(UrlEKLoverforsel) then            if TUtils.CheckUrl(UrlEKLoverforsel) then
2964            begin            begin
2965              logTekst := 'UrlEKLoverforsel accepteret: ' + UrlEKLoverforsel;              logTekst := 'UrlEKLoverforsel accepteret: ' + UrlEKLoverforsel;
2966              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 2990  begin Line 2989  begin
2989          // Tjekker UrlEKLoverforselPakkeshop          // Tjekker UrlEKLoverforselPakkeshop
2990          if PanelValg5.Enabled = true then          if PanelValg5.Enabled = true then
2991          begin          begin
2992            if CheckUrl(UrlEKLoverforselPakkeshop) then            if TUtils.CheckUrl(UrlEKLoverforselPakkeshop) then
2993            begin            begin
2994              logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;              logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;
2995              SkrivScanningLogFil(logTekst);              SkrivScanningLogFil(logTekst);
# Line 3017  begin Line 3016  begin
3016    
3017    
3018          // Tjekker UrlFindPakketype          // Tjekker UrlFindPakketype
3019          if CheckUrl(UrlFindPakketype) then          if TUtils.CheckUrl(UrlFindPakketype) then
3020          begin          begin
3021            logTekst := 'UrlFindPakketype accepteret: ' + UrlFindPakketype;            logTekst := 'UrlFindPakketype accepteret: ' + UrlFindPakketype;
3022            SkrivScanningLogFil(logTekst);            SkrivScanningLogFil(logTekst);
# Line 3042  begin Line 3041  begin
3041          end;          end;
3042    
3043          // Tjekker UrlSendPrograminfo          // Tjekker UrlSendPrograminfo
3044          if CheckUrl(UrlSendPrograminfo) then          if TUtils.CheckUrl(UrlSendPrograminfo) then
3045          begin          begin
3046            logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;            logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;
3047            SkrivScanningLogFil(logTekst);            SkrivScanningLogFil(logTekst);
# Line 5355  end; Line 5354  end;
5354    
5355    
5356    
 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;  
5357    
 end;  
5358    
5359    
5360  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
Legend:
Removed from v.2693  
changed lines
  Added in v.2694
  ViewVC Help
Powered by ViewVC 1.1.20