/[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 2678 by torben, Wed Aug 26 13:20:47 2015 UTC revision 2704 by torben, Fri Sep 4 09:56:58 2015 UTC
# Line 8  uses Line 8  uses
8    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,
9    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,
10    IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,    IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,
11    Winspool, Registry, ShellApi, ClipBrd, Buttons, wininet,    Winspool, ShellApi, ClipBrd, Buttons, wininet,
12    UITypes,    UITypes,
13    PakkeshopLabels,    PakkeshopLabels,
14    StBarC,    StBarC,
15    Math // DegToRad() bruges i PrintPakkeshopLabel    Math, // DegToRad() bruges i PrintPakkeshopLabel
16      Utils
17    
18    ;    ;
19    
20  type  type
   TStrArray = array of string;  
21    TMainForm = class(TForm)    TMainForm = class(TForm)
22      StregkodeST: TStaticText;      StregkodeST: TStaticText;
23      RuteNummerST: TStaticText;      RuteNummerST: TStaticText;
# Line 53  type Line 52  type
52      Testlyd1: TMenuItem;      Testlyd1: TMenuItem;
53      ListBox1: TListBox;      ListBox1: TListBox;
54      Budlevering1: TMenuItem;      Budlevering1: TMenuItem;
55      DownloadButton01: TButton;      BtnDownloadKontrolfil: TButton;
56      IdFTP1: TIdFTP;      IdFTP1: TIdFTP;
57      Image1: TImage;      Image1: TImage;
58      ListBox2: TListBox;      ListBox2: TListBox;
59      OpdaterListenButton01: TButton;      BtnOpdaterListen: TButton;
60      UploadButton01: TButton;      BtnUploadLogfil: TButton;
61      DownloadButton03: TButton;      BtnDownloadRuteskiftFil: TButton;
62      Pakkeshoplevering1: TMenuItem;      Pakkeshoplevering1: TMenuItem;
63      PakkeshopText1: TStaticText;      PakkeshopText1: TStaticText;
64      btnNulstil: TButton;      btnNulstil: TButton;
65      Returpakkerfrapakkeshop1: TMenuItem;      Returpakkerfrapakkeshop1: TMenuItem;
66      Altidprintepakkelabel1: TMenuItem;      Altidprintepakkelabel1: TMenuItem;
67      chkAltidPrintLabel: TCheckBox;      chkAltidPrintLabel: TCheckBox;
68      EKLoverforsel: TButton;      BtnEKLoverforsel: TButton;
69      N5: TMenuItem;      N5: TMenuItem;
70      Uploadlogfil1: TMenuItem;      Uploadlogfil1: TMenuItem;
71      Manual1: TMenuItem;      Manual1: TMenuItem;
# Line 94  type Line 93  type
93      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
94      menuIndlevering: TMenuItem;      menuIndlevering: TMenuItem;
95    
   
   function Explode(var a: TStrArray; Border, S: string): Integer;  
   function BarCodeValid (ACode: string): boolean;  
   function Sto_GetFmtFileVersion(const FileName: String = ''): String;  
   function TColorToHex(Color : TColor) : string;  
   function HexToTColor(sColor : string) : TColor;  
96    function getProddato() : TDate;    function getProddato() : TDate;
97    function getProddag() : String;    function getProddag() : String;
98    function retRutenummer(rutenummer : String) : String;    function retRutenummer(rutenummer : String) : String;
99    function GetCurrentPrinterHandle() : THandle;    function GetCurrentPrinterHandle() : THandle;
100    function SavePChar(p: PChar): PChar;    function SavePChar(p: PChar): PChar;
   function AdobeReaderExists(): Boolean;  
   function FileTime2DateTime(FileTime: TFileTime): TDateTime;  
   function split(input: string; schar: Char; s: Integer): string;  
   function CheckUrl(url:string):boolean;  
101    
102    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
103    procedure StartScreen();    procedure StartScreen();
# Line 139  type Line 128  type
128    procedure Button1Click(Sender: TObject);    procedure Button1Click(Sender: TObject);
129    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
130    procedure Budlevering1Click(Sender: TObject);    procedure Budlevering1Click(Sender: TObject);
131    procedure DownloadButton01Click(Sender: TObject);    procedure BtnDownloadKontrolfilClick(Sender: TObject);
132    procedure OpdaterListenButton01Click(Sender: TObject);    procedure BtnOpdaterListenClick(Sender: TObject);
133    procedure DownloadBladhusRuteskiftfil();    procedure DownloadBladhusRuteskiftfil();
134    procedure DownloadBladhusKontrolfil();    procedure DownloadBladhusKontrolfil();
135    procedure SendFilTilDAO(fil_type, filnavn_input, filnavn_output: String);    procedure SendFilTilDAO(fil_type, filnavn_input, filnavn_output: String);
# Line 148  type Line 137  type
137    procedure UploadInifilTilDAO();    procedure UploadInifilTilDAO();
138    procedure SletStregkodelinieFraListboks2(StregKode : String);    procedure SletStregkodelinieFraListboks2(StregKode : String);
139    procedure FormDestroy(Sender: TObject);    procedure FormDestroy(Sender: TObject);
140    procedure UploadButton01Click(Sender: TObject);    procedure BtnUploadLogfilClick(Sender: TObject);
141    procedure DownloadButton03Click(Sender: TObject);    procedure BtnDownloadRuteskiftFilClick(Sender: TObject);
142    procedure Pakkeshoplevering1Click(Sender: TObject);    procedure Pakkeshoplevering1Click(Sender: TObject);
143    procedure btnNulstilClick(Sender: TObject);    procedure btnNulstilClick(Sender: TObject);
144    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);
# Line 163  type Line 152  type
152    
153    procedure Altidprintepakkelabel1Click(Sender: TObject);    procedure Altidprintepakkelabel1Click(Sender: TObject);
154    procedure chkAltidPrintLabelClick(Sender: TObject);    procedure chkAltidPrintLabelClick(Sender: TObject);
155    procedure EKLoverforselClick(Sender: TObject);    procedure BtnEKLoverforselClick(Sender: TObject);
156    procedure Uploadlogfil1Click(Sender: TObject);    procedure Uploadlogfil1Click(Sender: TObject);
157    procedure Manual1Click(Sender: TObject);    procedure Manual1Click(Sender: TObject);
158    procedure Timer1Timer(Sender: TObject);    procedure Timer1Timer(Sender: TObject);
# Line 185  type Line 174  type
174    procedure SletLogfiler(Path: string; FileList: TStrings);    procedure SletLogfiler(Path: string; FileList: TStrings);
175    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
176    procedure TjekkerUrls();    procedure TjekkerUrls();
177      procedure TjekkerEnkeltUrl(UrlNavn: String; Url: String; var urlFejl: integer);
178    
   procedure RoundCornerOf(Control: TWinControl);  
179    procedure menuIndleveringClick(Sender: TObject);    procedure menuIndleveringClick(Sender: TObject);
180    
181    procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);    procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
# Line 199  type Line 188  type
188      SkrivLog : String;      SkrivLog : String;
189      Sted : String;      Sted : String;
190      StedNavn : String;      StedNavn : String;
191      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlEKLoverforsel : String;      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlIndleveringsPakkeManglendeScanninger,UrlEKLoverforsel : String;
192  // 29150330: start  // 29150330: start
193      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
194  // 20150330: slut  // 20150330: slut
# Line 213  type Line 202  type
202      AlarmLyd : String;      AlarmLyd : String;
203      ScannetOkLyd : String;      ScannetOkLyd : String;
204      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
205  // 20150317: start  
206      ScannetOkTilTjekkodeLyd : String;      ScannetOkTilTjekkodeLyd : String;
207  // 20150317: slut  
208      PrinterNavn : String;      PrinterNavn : String;
209      TjekPrinter : String;      TjekPrinter : String;
210      XPosRute : integer;      XPosRute : integer;
# Line 256  type Line 245  type
245    
246      Barcode : TStBarcode;      Barcode : TStBarcode;
247    
           function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }  
248    
249      procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');      procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');
250      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
# Line 290  var Line 278  var
278  implementation  implementation
279  {$R *.dfm}  {$R *.dfm}
280    
 function TMainForm.TColorToHex(Color : TColor) : string;  
 begin  
    Result :=  
      IntToHex(GetRValue(Color), 2) +  
      IntToHex(GetGValue(Color), 2) +  
      IntToHex(GetBValue(Color), 2) ;  
 end;  
   
 function TMainForm.HexToTColor(sColor : string) : TColor;  
 begin  
    Result :=  
      RGB(  
        StrToInt('$'+Copy(sColor, 1, 2)),  
        StrToInt('$'+Copy(sColor, 3, 2)),  
        StrToInt('$'+Copy(sColor, 5, 2))  
      ) ;  
 end;  
281    
282  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
283  begin  begin
284    
285  // 20150309: startr  
286      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
287  // 20150309: slut  
288    
289      Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component      Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
290    
# Line 359  begin Line 330  begin
330        PanelValg7.Font.Color := clWindowText;        PanelValg7.Font.Color := clWindowText;
331      end;      end;
332    
333      OpdaterListenButton01.Enabled := false;      BtnOpdaterListen.Enabled := false;
334    
335      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
336      begin      begin
# Line 413  begin Line 384  begin
384    
385      StartScreen();      StartScreen();
386      MainForm.Caption := Titel;      MainForm.Caption := Titel;
387      MainForm.Color := HexToTColor(Farve);      MainForm.Color := TUtils.HexToTColor(Farve);
388      MainForm.Farve := Farve;      MainForm.Farve := Farve;
389      MainForm.Titel := Titel;      MainForm.Titel := Titel;
390      MainForm.Url := Url;      MainForm.Url := Url;
# Line 473  begin Line 444  begin
444          end          end
445          else          else
446          begin          begin
447            logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
448          end;          end;
449          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
450        end        end
451        else        else
452        begin        begin
453          logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';          logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
454          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
455        end;        end;
456      end;      end;
# Line 522  end; Line 493  end;
493    
494  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);
495  begin  begin
 // 20150317: start  
 (*  
   if Automatiskvalg1.Checked then  
   begin  
      AutomatiskValg1.Checked := true;  
      PanelValgA.Color := clGreen;  
      PanelValgA.Font.Color := clWhite;  
   end  
   else  
   begin  
      AutomatiskValg1.Checked := false;  
      PanelValgA.Color := clBtnFace;  
      PanelValgA.Font.Color := clWindowText;  
   end;  
 *)  
496  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
497  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
498       AutomatiskValg1.Checked := true;       AutomatiskValg1.Checked := true;
499       PanelValgA.Color := clGreen;       PanelValgA.Color := clGreen;
500       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
 // 20150317: slut  
501  end;  end;
502    
503  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
# Line 561  begin Line 516  begin
516    
517    btnNulstil.BringToFront;    btnNulstil.BringToFront;
518    
519    RoundCornerOf(PanelManglendePakker1);    TUtils.RoundCornerOf(PanelManglendePakker1);
520    RoundCornerOf(PanelManglendePakker2);    TUtils.RoundCornerOf(PanelManglendePakker2);
521    RoundCornerOf(PanelManglendePakker3);    TUtils.RoundCornerOf(PanelManglendePakker3);
522    RoundCornerOf(PanelManglendePakker4);    TUtils.RoundCornerOf(PanelManglendePakker4);
523    RoundCornerOf(PanelManglendePakker5);    TUtils.RoundCornerOf(PanelManglendePakker5);
524    RoundCornerOf(PanelManglendePakker6);    TUtils.RoundCornerOf(PanelManglendePakker6);
525    
526    
527    // Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp    // Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp
# Line 602  begin Line 557  begin
557      UrlPakkeshopManglendeScanninger := ReadString('Settings','UrlPakkeshopManglendeScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendescanninger.php?sted=%s');      UrlPakkeshopManglendeScanninger := ReadString('Settings','UrlPakkeshopManglendeScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendescanninger.php?sted=%s');
558      UrlPakkeshopManglendeReturScanninger := ReadString('Settings','UrlPakkeshopManglendeReturScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendereturscanninger.php?sted=%s');      UrlPakkeshopManglendeReturScanninger := ReadString('Settings','UrlPakkeshopManglendeReturScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendereturscanninger.php?sted=%s');
559    
560    
561      UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s');      UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s');
562        UrlIndleveringsPakkeManglendeScanninger := ReadString('Settings', 'UrlIndleveringsPakkeManglendeScanninger','http://omdeling.info/webservices/pakkeshop/IndleveringsPakkeManglendeScanninger.php?sted=%s');
563    
564    
565    
566      LabelType := ReadInteger('Settings','LabelType',1);      LabelType := ReadInteger('Settings','LabelType',1);
# Line 642  begin Line 600  begin
600    
601      if (SkrivLog = '1') then      if (SkrivLog = '1') then
602      begin      begin
603        logTekst := 'Program start (Version: ' + Sto_GetFmtFileVersion('') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);        logTekst := 'Program start (Version: ' + TUtils.Sto_GetFmtFileVersion('') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);
604        try        try
605          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
606          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
607          UploadButton01.Enabled := true;          BtnUploadLogfil.Enabled := true;
608          logTekst := 'Programmet er installeret som: '+ParamStr(0);          logTekst := 'Programmet er installeret som: '+ParamStr(0);
609          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
610          // Oprydning i gamle logfiler          // Oprydning i gamle logfiler
# Line 785  begin Line 743  begin
743      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
744      // *************************** //      // *************************** //
745    
746    {$IfDef STED_BK}
747        SpecialVersionSted := 'BK';
748    {$EndIf}
749    {$IfDef STED_DBK}
750        SpecialVersionSted := 'DBK';
751    {$EndIf}
752    {$IfDef STED_FD}
753        SpecialVersionSted := 'FD';
754    {$EndIf}
755    {$IfDef STED_NS}
756        SpecialVersionSted := 'NS';
757    {$EndIf}
758    
759    
760      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
761      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
762      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 800  begin Line 772  begin
772      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)
773      // ændrer vi Sted og Scanningtype her:      // ændrer vi Sted og Scanningtype her:
774    
 // 20150313: start  
775      if SpecialVersionSted = 'NS' then      if SpecialVersionSted = 'NS' then
776      begin      begin
777         SpecialVersionSted := '01';         SpecialVersionSted := '01';
# Line 811  begin Line 782  begin
782         SpecialVersionSted := '03';         SpecialVersionSted := '03';
783         SpecialVersionScanningtype := '4';         SpecialVersionScanningtype := '4';
784      end;      end;
 // 20150313: slut  
785    
786      if SpecialVersionSted = 'BK' then      if SpecialVersionSted = 'BK' then
787      begin      begin
# Line 1156  begin Line 1126  begin
1126      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1127    
1128      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1129      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion(''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', TUtils.Sto_GetFmtFileVersion(''));
1130    
1131  end;  end;
1132    
# Line 1608  begin Line 1578  begin
1578             BoghandlerTjekkode := Stregkode;             BoghandlerTjekkode := Stregkode;
1579             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1580             if (PakkeshopLevering1.Checked) then             if (PakkeshopLevering1.Checked) then
1581                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := TUtils.HexToTColor(FarvePakkeshoplevering);
1582             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1583                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := TUtils.HexToTColor(FarveNormal);
1584             btnNulstil.Visible := false;             btnNulstil.Visible := false;
1585           end           end
1586          else          else
# Line 1631  begin Line 1601  begin
1601    
1602      if not PakkeshopLevering1.Checked and not Pakkernormal1.Checked or (PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '')) or (Pakkernormal1.Checked and (Scanogstjekkoden1.Checked and (BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked)) then      if not PakkeshopLevering1.Checked and not Pakkernormal1.Checked or (PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '')) or (Pakkernormal1.Checked and (Scanogstjekkoden1.Checked and (BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked)) then
1603      begin      begin
1604    
1605         if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then         if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then
1606            StregKode := PakkeshopStregkode;            StregKode := PakkeshopStregkode;
1607         if Pakkernormal1.Checked and ((BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked) then         if Pakkernormal1.Checked and ((BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked) then
# Line 1670  begin Line 1641  begin
1641           end;           end;
1642            if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then            if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then
1643            begin            begin
1644              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1645              if Storepakker1.Checked then              if Storepakker1.Checked then
1646              begin              begin
1647                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1683  begin Line 1654  begin
1654            end            end
1655            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1656            begin            begin
1657              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1658              if Storepakker1.Checked then              if Storepakker1.Checked then
1659              begin              begin
1660                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1705  begin Line 1676  begin
1676            begin            begin
1677              VisAlarmSkaerm('');              VisAlarmSkaerm('');
1678            end;            end;
1679    
1680           if not btnNulstil.Visible then           if not btnNulstil.Visible then
1681            begin            begin
1682    
# Line 1797  var Line 1769  var
1769    
1770    
1771  begin  begin
1772      if Budlevering1.Checked or Pakkeshoplevering1.Checked or Returpakkerfrapakkeshop1.Checked or Pakkernormal1.Checked then      if Budlevering1.Checked or Pakkeshoplevering1.Checked or Returpakkerfrapakkeshop1.Checked or Pakkernormal1.Checked or menuIndlevering.Checked then
1773      begin      begin
1774        for i := ListBox2.items.count-1 downto 0 do        for i := ListBox2.items.count-1 downto 0 do
1775          if pos(StregKode,ListBox2.items[i]) <> 0 then          if pos(StregKode,ListBox2.items[i]) <> 0 then
# Line 1808  begin Line 1780  begin
1780            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere
1781            begin            begin
1782              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen
1783              wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));              wrkAntalIdag := StrToInt( TUtils.split(wrkAntal, '/', 2));
1784  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
1785  //            ShowMessage(SPLIT('data/another/','/',3));  //            ShowMessage(SPLIT('data/another/','/',3));
1786  //            ShowMessage(SPLIT('data/another','/',3));  //            ShowMessage(SPLIT('data/another','/',3));
1787              wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));              wrkAntalSenere := StrToInt( TUtils.split(wrkAntal, '/', 3));
1788            end            end
1789            else     // kun idag            else     // kun idag
1790            begin            begin
# Line 1916  begin Line 1888  begin
1888                PanelManglendePakker6.Visible := false;                PanelManglendePakker6.Visible := false;
1889              end;              end;
1890            end;            end;
1891  // 20150310: slut  
1892            ListBox2.items.delete(i);            ListBox2.items.delete(i);
1893          end;          end;
1894      end;      end;
# Line 1952  begin Line 1924  begin
1924    Sprgefterboghandlernummer1.Enabled := false;    Sprgefterboghandlernummer1.Enabled := false;
1925    ListBox1.Visible := true;    ListBox1.Visible := true;
1926  //  TestFunktionen := '1';  //  TestFunktionen := '1';
1927  // 20150317: start  
 (*  
   if TestFunktionen = '1' then  
     begin  
       Testforbindelsen1.Visible := true;  
       Testprinter1.Visible := true;  
       Testlyd1.Visible := true;  
       Testlyd2.Visible := true;  
     end  
   else if TestFunktionen = '2' then  
     begin  
       Testforbindelsen1.Enabled := false;  
       Testprinter1.Enabled := false;  
       Testlyd1.Enabled := false;  
       Testlyd2.Enabled := false;  
     end  
   else  
     begin  
       Testforbindelsen1.Visible := false;  
       Testprinter1.Visible := false;  
       Testlyd1.Visible := false;  
       Testlyd2.Visible := false;  
     end;  
   Testprinter1.Visible := false;  
   AlarmLyd := 'Sounds\Alarm.wav';  
   if not FileExists(AlarmLyd) then  
     begin  
       AlarmLyd := '';  
     end;  
   ScannetOkLyd := 'Sounds\Ok.wav';  
   if not FileExists(ScannetOkLyd) then  
     begin  
       ScannetOkLyd := '';  
     end;  
   ScannetOkStorLyd := 'Sounds\Ok_stor.wav';  
   if not FileExists(ScannetOkStorLyd) then  
     begin  
       ScannetOkStorLyd := '';  
     end;  
 *)  
 // 20150317: slut  
1928    if Budlevering1.Checked then    if Budlevering1.Checked then
1929    begin    begin
1930      IndlesScanningLogFil();      IndlesScanningLogFil();
# Line 2005  begin Line 1937  begin
1937      01 :      01 :
1938            begin;      // NS            begin;      // NS
1939              Testprinter1.Visible := true;              Testprinter1.Visible := true;
1940              DownloadButton01.Enabled := true;              BtnDownloadKontrolfil.Enabled := true;
1941              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1942              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1943              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1944              BladhusKontrolfil_server := 'franordjyske/RuteKontrol.txt';              BladhusKontrolfil_server := 'franordjyske/RuteKontrol.txt';
# Line 2021  begin Line 1953  begin
1953              Storepakker1.Enabled := true;              Storepakker1.Enabled := true;
1954              radioStorPakke.Enabled := true;              radioStorPakke.Enabled := true;
1955              radioLillePakke.Enabled := true;              radioLillePakke.Enabled := true;
1956              DownloadButton01.Enabled := false;     // kontrolfil bruges ikke her              BtnDownloadKontrolfil.Enabled := false;     // kontrolfil bruges ikke her
1957              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1958              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1959              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1960              IndlesManglendeScanninger();              IndlesManglendeScanninger();
# Line 2032  begin Line 1964  begin
1964              Testprinter1.Visible := true;              Testprinter1.Visible := true;
1965             if (getProddag() = 'lørdag') then             if (getProddag() = 'lørdag') then
1966              begin              begin
1967                DownloadButton03.Visible := false;                BtnDownloadRuteskiftFil.Visible := false;
1968              end              end
1969              else              else
1970              begin              begin
1971                DownloadButton03.Visible := false;                BtnDownloadRuteskiftFil.Visible := false;
1972              end;              end;
1973              DownloadButton01.Enabled := true;              BtnDownloadKontrolfil.Enabled := true;
1974              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1975              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1976              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1977              BladhusRuteskiftfil_server := 'frafd/RuteSkift.txt';              BladhusRuteskiftfil_server := 'frafd/RuteSkift.txt';
# Line 2059  begin Line 1991  begin
1991              Storepakker1.Enabled := true;              Storepakker1.Enabled := true;
1992              radioStorPakke.Enabled := true;              radioStorPakke.Enabled := true;
1993              radioLillePakke.Enabled := true;              radioLillePakke.Enabled := true;
1994              DownloadButton01.Enabled := false;    // kontrolfil bruges ikke her              BtnDownloadKontrolfil.Enabled := false;    // kontrolfil bruges ikke her
1995              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1996              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1997              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1998            end;            end;
# Line 2180  begin Line 2112  begin
2112       begin       begin
2113         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label         PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2114         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc         PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2115           RuteNummer := PakkeshopLabel.Koreliste + '  ->  ' +  PakkeshopLabel.PakkeshopTurid;
2116           Stregkode := PakkeshopLabel.Stregkode;
2117    
2118         PrintPakkeshopLabel( PakkeshopLabel );         PrintPakkeshopLabel( PakkeshopLabel );
2119    
# Line 2313  begin Line 2247  begin
2247        List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;        List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;
2248      end;      end;
2249    end;    end;
2250      if menuIndlevering.Checked then
2251      begin
2252        List1Msg := Stregkode;
2253      end;
2254    
2255    
2256    ListBox1.Items.Insert(0,List1Msg);    ListBox1.Items.Insert(0,List1Msg);
2257    logTekst := RightStr(List1Msg, Length(List1Msg)-10);    logTekst := RightStr(List1Msg, Length(List1Msg)-10);
2258    SkrivScanningLogFil(logTekst);    SkrivScanningLogFil(logTekst);
2259  end;  end;
2260    
2261  procedure TMainForm.UploadButton01Click(Sender: TObject);  procedure TMainForm.BtnUploadLogfilClick(Sender: TObject);
2262  begin  begin
2263    UploadLogfilTilDAO();    UploadLogfilTilDAO();
2264    UploadInifilTilDAO();    UploadInifilTilDAO();
# Line 2335  pakkeForkertSted : Integer; Line 2275  pakkeForkertSted : Integer;
2275    nytRuteNummer, nyFarve : String;    nytRuteNummer, nyFarve : String;
2276  begin  begin
2277    if Budlevering1.Checked then    if Budlevering1.Checked then
2278       RuteNummerST.Color := HexToTColor(Farve);       RuteNummerST.Color := TUtils.HexToTColor(Farve);
2279    
2280    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
2281    if pakkeErScannet = 0 then    if pakkeErScannet = 0 then
# Line 2391  begin Line 2331  begin
2331            PrintNyLabel := true;            PrintNyLabel := true;
2332            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
2333            nyFarve := Farve;            nyFarve := Farve;
2334            RuteNummerST.Color := HexToTColor(nyFarve);            RuteNummerST.Color := TUtils.HexToTColor(nyFarve);
2335            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
2336            RuteNummer := nytRuteNummer;            RuteNummer := nytRuteNummer;
2337            ListBox1.Items.Insert(0,List1Msg);            ListBox1.Items.Insert(0,List1Msg);
# Line 2674  begin Line 2614  begin
2614    //UpdateScreen('', '', 'Tjekker forbindelsen...', '', '');    // virker ikke    //UpdateScreen('', '', 'Tjekker forbindelsen...', '', '');    // virker ikke
2615    ShowMessage('Tjekker data forbindelse til serveren.' + crlf + 'Det kan godt tage nogle minutter.' + crlf + 'Resultatet af testen vises i skærmbilledet...');    ShowMessage('Tjekker data forbindelse til serveren.' + crlf + 'Det kan godt tage nogle minutter.' + crlf + 'Resultatet af testen vises i skærmbilledet...');
2616    
2617          // Tjekker urls    try
2618          logTekst := 'Tjekker urls.';      // Tjekker urls
2619          ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);      logTekst := 'Tjekker urls.';
2620          SkrivScanningLogFil(logTekst);      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2621        SkrivScanningLogFil(logTekst);
2622    
         // Tjekker UrlNormal  
         if PanelValg1.Enabled = true then  
         begin  
           if CheckUrl(UrlNormal) then  
           begin  
             logTekst := 'UrlNormal accepteret: ' + UrlNormal;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlNormal svarer ikke: ' + UrlNormal;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               TjekUrls := '-';   // markerer at der var fejl  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2623    
         // Tjekker UrlReturDAO  
         if PanelValg2.Enabled = true then  
         begin  
           if CheckUrl(UrlReturDAO) then  
           begin  
             logTekst := 'UrlReturDAO accepteret: ' + UrlReturDAO;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlReturDAO svarer ikke: ' + UrlReturDAO;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2624    
2625          // Tjekker UrlReturBoghandler      // Tjekker UrlNormal
2626          if PanelValg3.Enabled = true then      if PanelValg1.Enabled = true then
2627          begin      begin
2628            if CheckUrl(UrlReturBoghandler) then        TjekkerEnkeltUrl('UrlNormal', UrlNormal, urlFejl);
2629            begin      end;
             logTekst := 'UrlReturBoghandler accepteret: ' + UrlReturBoghandler;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlReturDAO svarer ikke: ' + UrlReturDAO;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2630    
2631          // Tjekker UrlBudlevering      // Tjekker UrlReturDAO
2632          if PanelValg4.Enabled = true then      if PanelValg2.Enabled = true then
2633          begin      begin
2634            if CheckUrl(UrlBudlevering) then        TjekkerEnkeltUrl('UrlReturDAO', UrlReturDAO, urlFejl);
2635            begin      end;
             logTekst := 'UrlBudlevering accepteret: ' + UrlBudlevering;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlBudlevering svarer ikke: ' + UrlBudlevering;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2636    
2637          // Tjekker UrlPakkeshoplevering      // Tjekker UrlReturBoghandler
2638          if PanelValg5.Enabled = true then      if PanelValg3.Enabled = true then
2639          begin      begin
2640            if CheckUrl(UrlPakkeshoplevering) then        TjekkerEnkeltUrl('UrlReturBoghandler', UrlReturBoghandler, urlFejl);
2641            begin      end;
             logTekst := 'UrlPakkeshoplevering accepteret: ' + UrlPakkeshoplevering;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlPakkeshoplevering svarer ikke: ' + UrlPakkeshoplevering;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2642    
2643          // Tjekker UrlReturPakkeshop      // Tjekker UrlBudlevering
2644          if PanelValg6.Enabled = true then      if PanelValg4.Enabled = true then
2645          begin      begin
2646            if CheckUrl(UrlReturPakkeshop) then        TjekkerEnkeltUrl('UrlBudlevering', UrlBudlevering, urlFejl);
2647            begin      end;
             logTekst := 'UrlReturPakkeshop accepteret: ' + UrlReturPakkeshop;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlReturPakkeshop svarer ikke: ' + UrlReturPakkeshop;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2648    
2649          // Tjekker UrlManglendeScanninger      // Tjekker UrlPakkeshoplevering
2650          if (PanelValg1.Enabled = true)      if PanelValg5.Enabled = true then
2651          or (PanelValg4.Enabled = true) then      begin
2652          begin        TjekkerEnkeltUrl('UrlPakkeshoplevering', UrlPakkeshoplevering, urlFejl);
2653            if CheckUrl(UrlManglendeScanninger) then      end;
           begin  
             logTekst := 'UrlManglendeScanninger accepteret: ' + UrlManglendeScanninger;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlManglendeScanninger svarer ikke: ' + UrlManglendeScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2654    
2655          // Tjekker UrlPakkeshopManglendeScanninger      // Tjekker UrlReturPakkeshop
2656          if PanelValg5.Enabled = true then      if PanelValg6.Enabled = true then
2657          begin      begin
2658            if CheckUrl(UrlPakkeshopManglendeScanninger) then        TjekkerEnkeltUrl('UrlReturPakkeshop', UrlReturPakkeshop, urlFejl);
2659            begin      end;
             logTekst := 'UrlPakkeshopManglendeScanninger accepteret: ' + UrlPakkeshopManglendeScanninger;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlPakkeshopManglendeScanninger svarer ikke: ' + UrlPakkeshopManglendeScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2660    
2661          // Tjekker UrlPakkeshopManglendeReturScanninger      // Tjekker UrlManglendeScanninger
2662          if PanelValg6.Enabled = true then      if (PanelValg1.Enabled = true) or (PanelValg4.Enabled = true) then
2663          begin      begin
2664            if CheckUrl(UrlPakkeshopManglendeReturScanninger) then        TjekkerEnkeltUrl('UrlManglendeScanninger', UrlManglendeScanninger, urlFejl);
2665            begin      end;
             logTekst := 'UrlPakkeshopManglendeReturScanninger accepteret: ' + UrlPakkeshopManglendeReturScanninger;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlPakkeshopManglendeReturScanninger svarer ikke: ' + UrlPakkeshopManglendeReturScanninger;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2666    
2667          // Tjekker UrlEKLoverforsel      // Tjekker UrlPakkeshopManglendeScanninger
2668          if PanelValg1.Enabled = true then      if PanelValg5.Enabled = true then
2669          begin      begin
2670            if CheckUrl(UrlEKLoverforsel) then        TjekkerEnkeltUrl('UrlPakkeshopManglendeScanninger', UrlPakkeshopManglendeScanninger, urlFejl);
2671            begin      end;
             logTekst := 'UrlEKLoverforsel accepteret: ' + UrlEKLoverforsel;  
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlEKLoverforsel svarer ikke: ' + UrlEKLoverforsel;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2672    
2673        // Tjekker UrlPakkeshopManglendeReturScanninger
2674        if PanelValg6.Enabled = true then
2675        begin
2676          TjekkerEnkeltUrl('UrlPakkeshopManglendeReturScanninger', UrlPakkeshopManglendeReturScanninger, urlFejl);
2677        end;
2678    
2679          // Tjekker UrlEKLoverforselPakkeshop     // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger
2680          if PanelValg5.Enabled = true then      if PanelValg7.Enabled = true then
2681          begin      begin
2682            if CheckUrl(UrlEKLoverforselPakkeshop) then        TjekkerEnkeltUrl('UrlIndleveringsPakke', UrlIndleveringsPakke, urlFejl);
2683            begin        TjekkerEnkeltUrl('UrlIndleveringsPakkeManglendeScanninger', UrlIndleveringsPakkeManglendeScanninger, urlFejl);
2684              logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;      end;
             SkrivScanningLogFil(logTekst);  
           end  
           else  
           begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlEKLoverforselPakkeshop svarer ikke: ' + UrlEKLoverforselPakkeshop;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
           end;  
         end;  
2685    
2686        // Tjekker UrlEKLoverforsel
2687        if PanelValg1.Enabled = true then
2688        begin
2689          TjekkerEnkeltUrl('UrlEKLoverforsel', UrlEKLoverforsel, urlFejl);
2690        end;
2691    
         // Tjekker UrlFindPakketype  
         if CheckUrl(UrlFindPakketype) then  
         begin  
           logTekst := 'UrlFindPakketype accepteret: ' + UrlFindPakketype;  
           SkrivScanningLogFil(logTekst);  
         end  
         else  
         begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlFindPakketype svarer ikke: ' + UrlFindPakketype;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
         end;  
2692    
2693          // Tjekker UrlSendPrograminfo      // Tjekker UrlEKLoverforselPakkeshop
2694          if CheckUrl(UrlSendPrograminfo) then      if PanelValg5.Enabled = true then
2695          begin      begin
2696            logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;        TjekkerEnkeltUrl('UrlEKLoverforselPakkeshop', UrlEKLoverforselPakkeshop, urlFejl);
2697            SkrivScanningLogFil(logTekst);      end;
         end  
         else  
         begin  
             inc(urlFejl);   // Optæller antal fejl  
             logTekst := 'UrlSendPrograminfo svarer ikke: ' + UrlSendPrograminfo;  
             ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
             if TjekUrls = '1' then  
             begin  
               logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';  
             end;  
             SkrivScanningLogFil(logTekst);  
             if TjekUrls = '1' then  
             begin  
               ShowMessage(logTekst);  
               UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
               Application.Terminate;  
               exit;  
             end;  
         end;  
2698    
         if urlFejl > 0 then  
         begin  
           TjekUrls := '-';   // markerer at der var fejl  
         end  
         else  
         begin  
           logTekst := 'urls er ok';  
           ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);  
           SkrivScanningLogFil(logTekst);  
         end;  
2699    
2700        // Tjekker UrlFindPakketype
2701        TjekkerEnkeltUrl('UrlFindPakketype', UrlFindPakketype, urlFejl);
2702    
2703        // Tjekker UrlSendPrograminfo
2704        TjekkerEnkeltUrl('UrlSendPrograminfo', UrlSendPrograminfo, urlFejl);
2705    
2706    
2707    
2708        logTekst := 'urls er ok';
2709        ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2710        SkrivScanningLogFil(logTekst);
2711    
2712      Except
2713        TjekUrls := '-';   // markerer at der var fejl
2714    
2715      end;
2716  end;  end;
2717    
2718  function TMainForm.FileTime2DateTime(FileTime: TFileTime): TDateTime;  procedure TMainForm.TjekkerEnkeltUrl(UrlNavn: String; Url: String; var urlFejl: integer);
2719  var  const
2720     LocalFileTime: TFileTime;    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
    SystemTime: TSystemTime;  
2721  begin  begin
2722     FileTimeToLocalFileTime(FileTime, LocalFileTime) ;    if TUtils.CheckUrl(Url) then
2723     FileTimeToSystemTime(LocalFileTime, SystemTime) ;  
2724     Result := SystemTimeToDateTime(SystemTime) ;    begin
2725        logTekst := UrlNavn + ' accepteret: ' + Url;
2726        SkrivScanningLogFil(logTekst);
2727      end
2728      else
2729      begin
2730        inc(urlFejl);   // Optæller antal fejl
2731        logTekst := UrlNavn + ' svarer ikke: ' + Url;
2732        ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2733        if TjekUrls = '1' then
2734        begin
2735          logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';
2736        end;
2737    
2738        SkrivScanningLogFil(logTekst);
2739    
2740        if TjekUrls = '1' then
2741        begin
2742          ShowMessage(logTekst);
2743          UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut
2744          Application.Terminate;
2745    
2746          raise Exception.Create('UrlFejl');
2747    
2748        end;
2749      end;
2750    
2751  end;  end;
2752    
2753    
2754    
2755  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);
2756  var  var
2757    SR: TSearchRec;    SR: TSearchRec;
# Line 3083  begin Line 2771  begin
2771    
2772          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
2773          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
2774          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := TUtils.FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
2775          // Selvom creation date godt kan være forskellig fra modified date,          // Selvom creation date godt kan være forskellig fra modified date,
2776          // skal vi alligevel altid tjekke filens alder ud fra modified date          // skal vi alligevel altid tjekke filens alder ud fra modified date
2777          // (æ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 3142  begin Line 2830  begin
2830  //  MainForm.Color := HexToTColor(Farve);  //  MainForm.Color := HexToTColor(Farve);
2831    if Farve <> '' then    if Farve <> '' then
2832    begin    begin
2833       MainForm.Color := HexToTColor(Farve);       MainForm.Color := TUtils.HexToTColor(Farve);
 // 20150312: start  
 (*  
   end  
   else  
   begin  
      ShowMessage('Programmet afbrydes...');  
      UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut  
      Application.Terminate;  
 *)  
 // 20150312: slut  
2834    end;    end;
2835    if (Budlevering1.Checked) then    if (Budlevering1.Checked) then
2836    begin    begin
# Line 3216  end; Line 2894  end;
2894    
2895  procedure TMainForm.PanelValgAClick(Sender: TObject);  procedure TMainForm.PanelValgAClick(Sender: TObject);
2896  begin  begin
 // 20150311: start  
 (*  
   if PanelValgA.Color = clBtnFace then  
   begin  
      AutomatiskValg1.Checked := true;  
      PanelValgA.Color := clGreen;  
      PanelValgA.Font.Color := clWhite;  
   end  
   else  
   begin  
      AutomatiskValg1.Checked := false;  
      PanelValgA.Color := clBtnFace;  
      PanelValgA.Font.Color := clWindowText;  
   end;  
 *)  
2897  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
2898  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
2899       AutomatiskValg1.Checked := true;    AutomatiskValg1.Checked := true;
2900       PanelValgA.Color := clGreen;    PanelValgA.Color := clGreen;
2901       PanelValgA.Font.Color := clWhite;    PanelValgA.Font.Color := clWhite;
2902  // 20150311: slut  
2903    
2904    
2905  end;  end;
2906    
2907  procedure TMainForm.Pakkernormal1Click(Sender: TObject);  procedure TMainForm.Pakkernormal1Click(Sender: TObject);
# Line 3342  begin Line 3007  begin
3007    end;    end;
3008  end;  end;
3009    
3010  {  
  VERY fast split function  
  this function returns part of a string based on  
  constant defineable delimiters, such as ";". So  
  SPLIT('this is a test ',' ',3) = 'is' or  
  SPLIT('data;another;yet;again;more;',';',4) = 'yet'  
   
  Split function shifts index integer by two to  
  be compatible with commonly used PD split function  
  gpl 2004 / Juhani Suhonen  
 }  
 function TMainForm.split(input: string; schar: Char; s: Integer): string;  
 var  
   c: array of Integer;  
   b, t: Integer;  
 begin  
   Dec(s, 2);  // for compatibility with very old & slow split function  
   t := 0;     // variable T needs to be initialized...  
   setlength(c, Length(input));  
   for b := 0 to pred(High(c)) do  
   begin  
     c[b + 1] := posex(schar, input, succ(c[b]));  
     // BREAK LOOP if posex looped (position before previous)  
     // or wanted position reached..  
     if (c[b + 1] < c[b]) or (s < t) then break  
     else  
       Inc(t);  
   end;  
   Result := Copy(input, succ(c[s]), pred(c[s + 1] - c[s]));  
 end;  
3011    
3012  procedure TMainForm.Om1Click(Sender: TObject);  procedure TMainForm.Om1Click(Sender: TObject);
3013  const  const
# Line 3380  var Line 3016  var
3016   tekst, filversion : String;   tekst, filversion : String;
3017  begin  begin
3018    
3019    filversion := Sto_GetFmtFileVersion('');    filversion := TUtils.Sto_GetFmtFileVersion('');
3020    tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';    tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';
3021    
3022    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3402  begin Line 3038  begin
3038          end          end
3039          else          else
3040          begin          begin
3041            tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
3042          end;          end;
3043      end      end
3044      else      else
3045      begin      begin
3046        tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';        tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
3047      end;      end;
3048    end;    end;
3049    
# Line 3475  begin Line 3111  begin
3111    
3112    if FileExists(fileName) then    if FileExists(fileName) then
3113    begin    begin
3114      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3115      begin      begin
3116        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3117        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
# Line 3499  begin Line 3135  begin
3135    
3136    if FileExists(fileName) then    if FileExists(fileName) then
3137    begin    begin
3138      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3139      begin      begin
3140        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3141        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
3142      end      end
3143      else      else
3144      begin      begin
3145        ShowMessage('Acrobat Reader er ikke installeret!');        ShowMessage('Adobe Reader er ikke installeret!');
3146      end;      end;
3147    end    end
3148    else    else
# Line 3572  begin Line 3208  begin
3208        radioStorPakke.Enabled := false;        radioStorPakke.Enabled := false;
3209        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3210        ListBox1.Visible := true;        ListBox1.Visible := true;
3211        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3212        EKLoverforsel.Enabled := true;        BtnEKLoverforsel.Enabled := true;
3213        InitLillePakke();        InitLillePakke();
3214        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3215        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3606  begin Line 3242  begin
3242        ListBox1.Visible := true;        ListBox1.Visible := true;
3243        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3244        ListBox2.Items.Clear;        ListBox2.Items.Clear;
3245        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3246        InitLillePakke();        InitLillePakke();
3247  end;  end;
3248    
# Line 3632  begin Line 3268  begin
3268        ListBox1.Visible := true;        ListBox1.Visible := true;
3269        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3270        ListBox2.Items.Clear;        ListBox2.Items.Clear;
3271        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3272        InitLillePakke();        InitLillePakke();
3273  end;  end;
3274    
# Line 3658  begin Line 3294  begin
3294        radioLillePakke.Enabled := true;        radioLillePakke.Enabled := true;
3295        ListBox1.Visible := true;        ListBox1.Visible := true;
3296        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3297        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3298        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3299        DownloadButton03.Visible := false;        BtnDownloadRuteskiftFil.Visible := false;
3300        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3301        IdFTP1.Passive := true;        IdFTP1.Passive := true;
3302        IdFTP1.PassiveUseControlHost := true;        IdFTP1.PassiveUseControlHost := true;
3303        if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then        if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then
# Line 3694  begin Line 3330  begin
3330        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3331        ListBox1.Visible := true;        ListBox1.Visible := true;
3332        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3333        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3334        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3335    
3336        EKLoverforsel.Enabled := true;        BtnEKLoverforsel.Enabled := true;
3337    
3338        InitLillePakke();        InitLillePakke();
3339        IndlesScanningLogFil();        IndlesScanningLogFil();
# Line 3731  begin Line 3367  begin
3367        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3368        ListBox1.Visible := true;        ListBox1.Visible := true;
3369        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3370        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3371        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3372        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3373        InitLillePakke();        InitLillePakke();
3374        IndlesScanningLogFil();        IndlesScanningLogFil();
3375        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3778  begin Line 3414  begin
3414        ListBox1.Visible := true;        ListBox1.Visible := true;
3415        ListBox1.Items.Clear();        ListBox1.Items.Clear();
3416    
3417        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3418        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3419        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3420        InitLillePakke();        InitLillePakke();
3421        IndlesScanningLogFil();        IndlesScanningLogFil();
3422        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3818  begin Line 3454  begin
3454  // 20150310: slut  // 20150310: slut
3455  end;  end;
3456    
 /// <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>  
 function TMainForm.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]]);  
3457    
   end;  
 end;  
3458    
3459  procedure TMainForm.PlaySound(filename : PWideChar);  procedure TMainForm.PlaySound(filename : PWideChar);
3460  begin  begin
# Line 3942  begin; Line 3525  begin;
3525    CheckCode();    CheckCode();
3526  end;  end;
3527    
3528  procedure TMainForm.EKLoverforselClick(Sender: TObject);  procedure TMainForm.BtnEKLoverforselClick(Sender: TObject);
3529  var  var
3530    WebSvar : String;    WebSvar : String;
3531    URLStr : String;    URLStr : String;
# Line 3952  var Line 3535  var
3535    status, kommentar : String;    status, kommentar : String;
3536    
3537  begin  begin
3538      EKLoverforsel.Enabled := false;      BtnEKLoverforsel.Enabled := false;
3539    
3540      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Overfører de scannede pakker til EKL');      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Overfører de scannede pakker til EKL');
3541      logTekst := 'Overfører de scannede pakker til EKL';      logTekst := 'Overfører de scannede pakker til EKL';
3542      SkrivScanningLogFil(logTekst);      SkrivScanningLogFil(logTekst);
3543      StedKode := Sted;      StedKode := Sted;
3544      URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);      URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);
3545  // 20150330: start  
3546      if PanelValg5.Color = clGreen then      if PanelValg5.Color = clGreen then
3547      begin      begin
3548        URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);        URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);
3549      end;      end;
3550  // 20150330: slut  
3551    
3552      try      try
3553      //raise EIdConnClosedGracefully.Create('test');   // KUN TIL TEST      //raise EIdConnClosedGracefully.Create('test');   // KUN TIL TEST
# Line 4015  begin Line 3598  begin
3598        end;        end;
3599      end;      end;
3600    
3601      EKLoverforsel.Enabled := true;      BtnEKLoverforsel.Enabled := true;
3602    
3603      ListBox1.SetFocus;  // for at flytte fokus væk fra knappen så denne ikke aktiveres ved scanning / indtastning af stregkode      ListBox1.SetFocus;  // for at flytte fokus væk fra knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
3604    
# Line 4056  begin Line 3639  begin
3639    else    else
3640      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
3641  }  }
3642    Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;    Svar := 'Beregnet: ' + TUtils.CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
3643    
3644    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
3645    CheckCode();    CheckCode();
# Line 4064  end; Line 3647  end;
3647    
3648  end;  end;
3649    
 function TMainForm.BarCodeValid (ACode: string): boolean;  
 var  
    I: integer;  
    SumOdd, SumEven: integer;  
    ADigit, AChecksumDigit: integer;  
 begin  
    SumOdd := 0;  
    SumEven := 0;  
    for I := 1 to (Length (ACode) - 1) do begin  
       ADigit := StrToIntDef (ACode [I], 0);  
       if (I MOD 2 = 0) then begin  
          SumEven := SumEven + ADigit;  
       end else begin  
          SumOdd := SumOdd + ADigit;  
       end; {if}  
    end; {for}  
    AChecksumDigit := StrToIntDef (ACode [Length (ACode)], 0);  
    Result := ((SumOdd*3 + SumEven + AChecksumDigit) MOD 10 = 0);  
 end; {--BarCodeValid--}  
   
 { used for EAN 8/13 }  
 function TMainForm.CheckSumModulo10(const data:string):string;  
         var i,fak,sum : Integer;  
 begin  
         sum := 0;  
         fak := Length(data);  
         for i:=1 to Length(data) do  
         begin  
                 if (fak mod 2) = 0 then  
                         sum := sum + (StrToInt(data[i])*1)  
                 else  
                         sum := sum + (StrToInt(data[i])*3);  
                 dec(fak);  
         end;  
         if (sum mod 10) = 0 then  
                 result := data+'0'  
         else  
                 result := data+IntToStr(10-(sum mod 10));  
 end;  
3650    
3651  //  //
3652  // Bladhus ***  // Bladhus ***
# Line 4580  begin Line 4124  begin
4124    ListBox1.SetFocus;  // for at flytte fokus væk fra upload knappen så denne ikke aktiveres ved scanning / indtastning af stregkode    ListBox1.SetFocus;  // for at flytte fokus væk fra upload knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
4125  end;  end;
4126    
4127  procedure TMainForm.DownloadButton01Click(Sender: TObject);  procedure TMainForm.BtnDownloadKontrolfilClick(Sender: TObject);
4128  begin  begin
4129      DownloadBladhusKontrolfil();      DownloadBladhusKontrolfil();
4130      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
4131  end;  end;
4132    
4133  procedure TMainForm.OpdaterListenButton01Click(Sender: TObject);  procedure TMainForm.BtnOpdaterListenClick(Sender: TObject);
4134  const  const
4135    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
4136    
# Line 4595  begin Line 4139  begin
4139      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
4140  end;  end;
4141    
4142  procedure TMainForm.DownloadButton03Click(Sender: TObject);  procedure TMainForm.BtnDownloadRuteskiftFilClick(Sender: TObject);
4143  begin  begin
4144      if (getProddag() = 'lørdag') then      if (getProddag() = 'lørdag') then
4145      begin      begin
# Line 4604  begin Line 4148  begin
4148      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode      ListBox1.SetFocus;  // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
4149  end;  end;
4150    
 function TMainForm.Explode(var a: TStrArray; Border, S: string): Integer;  
 var  
   S2: string;  
 begin  
   Result  := 0;  
   S2 := S + Border;  
   repeat  
     SetLength(A, Length(A) + 1);  
     a[Result] := Copy(S2, 0,Pos(Border, S2) - 1);  
     Delete(S2, 1,Length(a[Result] + Border));  
     Inc(Result);  
   until S2 = '';  
 end;  
4151    
4152  // ToDo: PrintPakkeshopLabel()  // ToDo: PrintPakkeshopLabel()
4153  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);  procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
# Line 4624  var Line 4155  var
4155    XForm, XFormOld: TXForm; //Bruges til rotate X-formation    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4156    Angle: integer;    Angle: integer;
4157    gMode: integer;    gMode: integer;
   BarcodeArea: TRect;  
4158    Dirigering: string;    Dirigering: string;
4159    
4160  begin  begin
# Line 4777  var Line 4307  var
4307        end;        end;
4308    
4309    
4310      if (Scanningtype = '6') then  
4311        if (Scanningtype = '7') then
4312       begin       begin
4313        URLStr := Format(UrlPakkeshopManglendeReturScanninger,[StedKode]);        URLStr := Format(UrlIndleveringsPakkeManglendeScanninger, [StedKode]);
4314         end
4315        else if (Scanningtype = '6') then
4316         begin
4317          URLStr := Format(UrlPakkeshopManglendeReturScanninger, [StedKode]);
4318       end       end
4319      else if (Scanningtype = '5') then      else if (Scanningtype = '5') then
4320       begin       begin
4321        URLStr := Format(UrlPakkeshopManglendeScanninger,[StedKode]);        URLStr := Format(UrlPakkeshopManglendeScanninger, [StedKode]);
4322       end       end
4323      else if (Scanningtype = '1') then      else if (Scanningtype = '1') then
4324       begin       begin
# Line 4903  var Line 4438  var
4438                  antalFelterFundet := antalFelterFundet + 1;                  antalFelterFundet := antalFelterFundet + 1;
4439                  if (tjekkodestatus = '-1') then                  if (tjekkodestatus = '-1') then
4440                  begin                  begin
4441  // 20150306: start  
 //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  
4442                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4443                    begin                    begin
4444                      stregkoderMedTjekkodeArray[linienr] := split(stregkode, ' ', 2);  // Fjerner lige en evt. fremtidig dato fra feltet                      stregkoderMedTjekkodeArray[linienr] := TUtils.split(stregkode, ' ', 2);  // Fjerner lige en evt. fremtidig dato fra feltet
4445                    end                    end
4446                    else                    else
4447                    begin                    begin
# Line 5189  begin Line 4723  begin
4723          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
4724          S := buffer;          S := buffer;
4725          SetLength(A,0);          SetLength(A,0);
4726          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
4727          if (length(A) < 2) then          if (length(A) < 2) then
4728          begin          begin
4729            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
4730          end;          end;
4731            if (length(A) > 1) then            if (length(A) > 1) then
4732            begin            begin
# Line 5266  begin Line 4800  begin
4800          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
4801          S := buffer;          S := buffer;
4802          SetLength(A,0);          SetLength(A,0);
4803          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
4804          if (length(A) < 3) then          if (length(A) < 3) then
4805          begin          begin
4806            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
4807          end;          end;
4808          if (A[0]=imorgenYmd) then          if (A[0]=imorgenYmd) then
4809          begin          begin
# Line 5470  begin Line 5004  begin
5004    end;    end;
5005  end;  end;
5006    
 function TMainForm.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;  
5007    
5008    
 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;  
5009    
 end;  
5010    
5011    
 procedure TMainForm.RoundCornerOf(Control: TWinControl);  
 var  
    R: TRect;  
    Rgn: HRGN;  
 begin  
    with Control do  
    begin  
      R := ClientRect;  
 //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;  
      rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 25, 25) ;  
 //     rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 30, 30) ;  
      Perform(EM_GETRECT, 0, lParam(@r)) ;  
      InflateRect(r, - 4, - 4) ;  
      Perform(EM_SETRECTNP, 0, lParam(@r)) ;  
      SetWindowRgn(Handle, rgn, True) ;  
      Invalidate;  
    end;  
 end;  
5012    
5013  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5014  type  type
Legend:
Removed from v.2678  
changed lines
  Added in v.2704
  ViewVC Help
Powered by ViewVC 1.1.20