/[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 2660 by torben, Sun Aug 23 14:45:16 2015 UTC revision 2694 by torben, Thu Sep 3 14:31:39 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,
14      StBarC,
15      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 49  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;
# Line 58  type Line 61  type
61      DownloadButton03: TButton;      DownloadButton03: TButton;
62      Pakkeshoplevering1: TMenuItem;      Pakkeshoplevering1: TMenuItem;
63      PakkeshopText1: TStaticText;      PakkeshopText1: TStaticText;
64      PakkeshopNulstil: TButton;      btnNulstil: TButton;
65      Returpakkerfrapakkeshop1: TMenuItem;      Returpakkerfrapakkeshop1: TMenuItem;
66      Altidprintepakkelabel1: TMenuItem;      Altidprintepakkelabel1: TMenuItem;
67      chkAltidPrintLabel: TCheckBox;      chkAltidPrintLabel: TCheckBox;
# Line 88  type Line 91  type
91      PanelManglendePakker4: TPanel;      PanelManglendePakker4: TPanel;
92      PanelManglendePakker5: TPanel;      PanelManglendePakker5: TPanel;
93      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
94        menuIndlevering: TMenuItem;
95    
   
   function Explode(var a: TStrArray; Border, S: string): Integer;  
   function BarCodeValid (ACode: string): boolean;  
   function Sto_GetFmtFileVersion(const FileName: String = ''; const Fmt: String = '%d.%d.%d.%d'): 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;
101    function AdobeReaderExists(): Boolean;  
102    function FileTime2DateTime(FileTime: TFileTime): TDateTime;    function FileTime2DateTime(FileTime: TFileTime): TDateTime;
   function split(input: string; schar: Char; s: Integer): string;  
   function CheckUrl(url:string):boolean;  
103    
104    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
105    procedure StartScreen();    procedure StartScreen();
# Line 134  type Line 130  type
130    procedure Button1Click(Sender: TObject);    procedure Button1Click(Sender: TObject);
131    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
132    procedure Budlevering1Click(Sender: TObject);    procedure Budlevering1Click(Sender: TObject);
133    procedure DownloadButton01Click(Sender: TObject);    procedure BtnDownloadKontrolfilClick(Sender: TObject);
134    procedure OpdaterListenButton01Click(Sender: TObject);    procedure OpdaterListenButton01Click(Sender: TObject);
135    procedure DownloadBladhusRuteskiftfil();    procedure DownloadBladhusRuteskiftfil();
136    procedure DownloadBladhusKontrolfil();    procedure DownloadBladhusKontrolfil();
# Line 146  type Line 142  type
142    procedure UploadButton01Click(Sender: TObject);    procedure UploadButton01Click(Sender: TObject);
143    procedure DownloadButton03Click(Sender: TObject);    procedure DownloadButton03Click(Sender: TObject);
144    procedure Pakkeshoplevering1Click(Sender: TObject);    procedure Pakkeshoplevering1Click(Sender: TObject);
145    procedure PakkeshopNulstilClick(Sender: TObject);    procedure btnNulstilClick(Sender: TObject);
146    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);
147    procedure InitNatxpresslevering();    procedure InitNatxpresslevering();
148    procedure InitReturFraDao();    procedure InitReturFraDao();
# Line 161  type Line 157  type
157    procedure EKLoverforselClick(Sender: TObject);    procedure EKLoverforselClick(Sender: TObject);
158    procedure Uploadlogfil1Click(Sender: TObject);    procedure Uploadlogfil1Click(Sender: TObject);
159    procedure Manual1Click(Sender: TObject);    procedure Manual1Click(Sender: TObject);
   procedure CheckPrintQue(tjektype : string);  
160    procedure Timer1Timer(Sender: TObject);    procedure Timer1Timer(Sender: TObject);
161    procedure Scanogstjekkoden1Click(Sender: TObject);    procedure Scanogstjekkoden1Click(Sender: TObject);
162    procedure chkScanTjekkodeClick(Sender: TObject);    procedure chkScanTjekkodeClick(Sender: TObject);
# Line 181  type Line 176  type
176    procedure SletLogfiler(Path: string; FileList: TStrings);    procedure SletLogfiler(Path: string; FileList: TStrings);
177    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
178    procedure TjekkerUrls();    procedure TjekkerUrls();
 // 20150310: start  
   procedure RoundCornerOf(Control: TWinControl);  
179    
180      procedure menuIndleveringClick(Sender: TObject);
181    
182      procedure PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
183      procedure CheckPrintQue(tjektype : string);
184    
 // 20150310: slut  
185    
186    private    private
187      SpecialVersionSted, SpecialVersionScanningtype: String;    // Bruges når programmet skal bruges udenfor DAO scanningssteder      SpecialVersionSted, SpecialVersionScanningtype: String;    // Bruges når programmet skal bruges udenfor DAO scanningssteder
# Line 193  type Line 189  type
189      SkrivLog : String;      SkrivLog : String;
190      Sted : String;      Sted : String;
191      StedNavn : String;      StedNavn : String;
192      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlEKLoverforsel : String;      Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlIndleveringsPakke,UrlIndleveringsPakkeManglendeScanninger,UrlEKLoverforsel : String;
193  // 29150330: start  // 29150330: start
194      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
195  // 20150330: slut  // 20150330: slut
# Line 207  type Line 203  type
203      AlarmLyd : String;      AlarmLyd : String;
204      ScannetOkLyd : String;      ScannetOkLyd : String;
205      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
206  // 20150317: start  
207      ScannetOkTilTjekkodeLyd : String;      ScannetOkTilTjekkodeLyd : String;
208  // 20150317: slut  
209      PrinterNavn : String;      PrinterNavn : String;
210      TjekPrinter : String;      TjekPrinter : String;
211      XPosRute : integer;      XPosRute : integer;
# Line 248  type Line 244  type
244      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
245      TjekUrls : String;      TjekUrls : String;
246    
247            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }      Barcode : TStBarcode;
248    
249    
250      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 = '');
251      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 266  type Line 263  type
263      { Public declarations }      { Public declarations }
264    end;    end;
265    
266          function GetPixelsPerInchX(): Integer;
267        function GetPixelsPerInchY(): Integer;
268    
269  var  var
270    MainForm: TMainForm;    MainForm: TMainForm;
271    
# Line 279  var Line 279  var
279  implementation  implementation
280  {$R *.dfm}  {$R *.dfm}
281    
 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;  
282    
283  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
284  begin  begin
# Line 304  begin Line 287  begin
287      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
288  // 20150309: slut  // 20150309: slut
289    
290        Barcode := TStBarcode.Create(MainForm);//Dynamisk oprettelse af Barcode component
291    
292      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
293      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
294      begin      begin
# Line 400  begin Line 385  begin
385    
386      StartScreen();      StartScreen();
387      MainForm.Caption := Titel;      MainForm.Caption := Titel;
388      MainForm.Color := HexToTColor(Farve);      MainForm.Color := TUtils.HexToTColor(Farve);
389      MainForm.Farve := Farve;      MainForm.Farve := Farve;
390      MainForm.Titel := Titel;      MainForm.Titel := Titel;
391      MainForm.Url := Url;      MainForm.Url := Url;
# Line 460  begin Line 445  begin
445          end          end
446          else          else
447          begin          begin
448            logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
449          end;          end;
450          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
451        end        end
452        else        else
453        begin        begin
454          logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';          logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
455          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
456        end;        end;
457      end;      end;
# Line 509  end; Line 494  end;
494    
495  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);
496  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;  
 *)  
497  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
498  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
499       AutomatiskValg1.Checked := true;       AutomatiskValg1.Checked := true;
500       PanelValgA.Color := clGreen;       PanelValgA.Color := clGreen;
501       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
 // 20150317: slut  
502  end;  end;
503    
504  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
# Line 546  begin Line 515  begin
515    PrinterstatusStaticText1.Caption := '';    PrinterstatusStaticText1.Caption := '';
516    PrinterstatusStaticText1.Color := MainForm.Color;    PrinterstatusStaticText1.Color := MainForm.Color;
517    
518    PakkeshopNulstil.BringToFront;    btnNulstil.BringToFront;
519    
520    RoundCornerOf(PanelManglendePakker1);    TUtils.RoundCornerOf(PanelManglendePakker1);
521    RoundCornerOf(PanelManglendePakker2);    TUtils.RoundCornerOf(PanelManglendePakker2);
522    RoundCornerOf(PanelManglendePakker3);    TUtils.RoundCornerOf(PanelManglendePakker3);
523    RoundCornerOf(PanelManglendePakker4);    TUtils.RoundCornerOf(PanelManglendePakker4);
524    RoundCornerOf(PanelManglendePakker5);    TUtils.RoundCornerOf(PanelManglendePakker5);
525    RoundCornerOf(PanelManglendePakker6);    TUtils.RoundCornerOf(PanelManglendePakker6);
526    
527    
528    // 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 588  begin Line 557  begin
557      UrlReturPakkeshop := ReadString('Settings','UrlReturPakkeshop','http://omdeling.info/webservices/pakkeshop/returpakkekontrol.php?sted=%s&stregkode=%s');      UrlReturPakkeshop := ReadString('Settings','UrlReturPakkeshop','http://omdeling.info/webservices/pakkeshop/returpakkekontrol.php?sted=%s&stregkode=%s');
558      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');
559      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');
560    
561    
562        UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s');
563        UrlIndleveringsPakkeManglendeScanninger := ReadString('Settings', 'UrlIndleveringsPakkeManglendeScanninger','http://omdeling.info/webservices/pakkeshop/IndleveringsPakkeManglendeScanninger.php?sted=%s');
564    
565    
566    
567      LabelType := ReadInteger('Settings','LabelType',1);      LabelType := ReadInteger('Settings','LabelType',1);
568      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');
569      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');
# Line 625  begin Line 601  begin
601    
602      if (SkrivLog = '1') then      if (SkrivLog = '1') then
603      begin      begin
604        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);
605        try        try
606          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
607          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
# Line 768  begin Line 744  begin
744      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
745      // *************************** //      // *************************** //
746    
747    {$IfDef STED_BK}
748        SpecialVersionSted := 'BK';
749    {$EndIf}
750    {$IfDef STED_DBK}
751        SpecialVersionSted := 'DBK';
752    {$EndIf}
753    {$IfDef STED_FD}
754        SpecialVersionSted := 'FD';
755    {$EndIf}
756    {$IfDef STED_NS}
757        SpecialVersionSted := 'NS';
758    {$EndIf}
759    
760    
761      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
762      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
763      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 783  begin Line 773  begin
773      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)
774      // ændrer vi Sted og Scanningtype her:      // ændrer vi Sted og Scanningtype her:
775    
 // 20150313: start  
776      if SpecialVersionSted = 'NS' then      if SpecialVersionSted = 'NS' then
777      begin      begin
778         SpecialVersionSted := '01';         SpecialVersionSted := '01';
# Line 794  begin Line 783  begin
783         SpecialVersionSted := '03';         SpecialVersionSted := '03';
784         SpecialVersionScanningtype := '4';         SpecialVersionScanningtype := '4';
785      end;      end;
 // 20150313: slut  
786    
787      if SpecialVersionSted = 'BK' then      if SpecialVersionSted = 'BK' then
788      begin      begin
# Line 834  begin Line 822  begin
822        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
823        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
824        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
825          PanelValg7.Enabled := false;
826          PanelValg7.Font.Color := clInactiveCaption;
827    
828       // her skal vi også disable de menupunkter DBK ikke kan bruge       // her skal vi også disable de menupunkter DBK ikke kan bruge
829        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
830        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
# Line 870  begin Line 861  begin
861        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
862        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
863        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
864          PanelValg7.Enabled := false;
865          PanelValg7.Font.Color := clInactiveCaption;
866       // her skal vi også disable de menupunkter Bladhusene (01, 02, 03 og 04) ikke kan bruge       // her skal vi også disable de menupunkter Bladhusene (01, 02, 03 og 04) ikke kan bruge
867    
868        Automatiskvalg1.Enabled := false;        Automatiskvalg1.Enabled := false;
# Line 965  begin Line 958  begin
958             RutenummerST.Caption := '';             RutenummerST.Caption := '';
959             BoghandlerNavnST.Caption := 'Fejl i urls';             BoghandlerNavnST.Caption := 'Fejl i urls';
960             KommentarST.Caption := 'Se log vinduet';             KommentarST.Caption := 'Se log vinduet';
961             PakkeshopNulstil.Visible := true;             btnNulstil.Visible := true;
962             exit;             exit;
963          end;          end;
964      end      end
# Line 1134  begin Line 1127  begin
1127      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1128    
1129      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1130      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', TUtils.Sto_GetFmtFileVersion(''));
1131    
1132  end;  end;
1133    
# Line 1214  begin Line 1207  begin
1207    
1208      if StregKode = 'Nulstil' then      if StregKode = 'Nulstil' then
1209      begin      begin
1210         PakkeshopNulstil.Click();         btnNulstil.Click();
1211         exit;         exit;
1212      end;      end;
1213    
1214      if PakkeshopNulstil.Visible then      if btnNulstil.Visible then
1215      begin      begin
1216        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );
1217    
# Line 1543  begin Line 1536  begin
1536             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1537             BoghandlerTjekkode := '';             BoghandlerTjekkode := '';
1538             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1539             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1540             Stregkode := '';             Stregkode := '';
1541             InitScreen();             InitScreen();
1542        end        end
# Line 1555  begin Line 1548  begin
1548             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1549             BoghandlerTjekkode := '-1';             BoghandlerTjekkode := '-1';
1550             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1551             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1552             Stregkode := '';             Stregkode := '';
1553             InitScreen();             InitScreen();
1554        end        end
# Line 1586  begin Line 1579  begin
1579             BoghandlerTjekkode := Stregkode;             BoghandlerTjekkode := Stregkode;
1580             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1581             if (PakkeshopLevering1.Checked) then             if (PakkeshopLevering1.Checked) then
1582                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := TUtils.HexToTColor(FarvePakkeshoplevering);
1583             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1584                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := TUtils.HexToTColor(FarveNormal);
1585             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1586           end           end
1587          else          else
1588           begin           begin
# Line 1621  begin Line 1614  begin
1614            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her
1615            if Rutenummer = 'sql fejl' then            if Rutenummer = 'sql fejl' then
1616            begin   // Her skal komme en alarm og rød skærm            begin   // Her skal komme en alarm og rød skærm
1617               PlaySound(PWideChar(AlarmLyd));               VisAlarmSkaerm( 'SQL fejl: ' + Kommentar );
1618               //List1msg := 'SQL fejl: ' + Kommentar;  
              //ListBox1.Items.Insert(0,List1Msg);  
              MainForm.Color := clRed;  
              //KommentarST.Caption := List1msg;  
              PakkeshopNulstil.Visible := true;  
1619              exit;              exit;
1620            end;            end;
1621            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then
# Line 1646  begin Line 1635  begin
1635              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then
1636              begin              begin
1637                PlaySound(PWideChar(AlarmLyd));                PlaySound(PWideChar(AlarmLyd));
1638                PakkeshopNulstil.Visible := true;                btnNulstil.Visible := true;
1639                MainForm.Color := clRed;                MainForm.Color := clRed;
1640              end;              end;
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 1661  begin Line 1650  begin
1650              begin              begin
1651                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1652              end;              end;
1653              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
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 1674  begin Line 1663  begin
1663              begin              begin
1664                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1665              end;              end;
1666              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1667            end            end
1668            else if Copy(Kommentar,1,8) = 'OPRETTET' then            else if Copy(Kommentar,1,8) = 'OPRETTET' then
1669            begin            begin
# Line 1685  begin Line 1674  begin
1674            end            end
1675            else            else
1676            begin            begin
1677              MainForm.Color := clRed;              VisAlarmSkaerm('');
             PlaySound(PWideChar(AlarmLyd));  
             PakkeshopNulstil.Visible := true;  
1678            end;            end;
1679           if not PakkeshopNulstil.Visible then           if not btnNulstil.Visible then
1680            begin            begin
1681    
1682              If (Budlevering1.Checked) then              If (Budlevering1.Checked) then
# Line 1792  begin Line 1779  begin
1779            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere
1780            begin            begin
1781              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen
1782              wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));              wrkAntalIdag := StrToInt( TUtils.split(wrkAntal, '/', 2));
1783  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
1784  //            ShowMessage(SPLIT('data/another/','/',3));  //            ShowMessage(SPLIT('data/another/','/',3));
1785  //            ShowMessage(SPLIT('data/another','/',3));  //            ShowMessage(SPLIT('data/another','/',3));
1786              wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));              wrkAntalSenere := StrToInt( TUtils.split(wrkAntal, '/', 3));
1787            end            end
1788            else     // kun idag            else     // kun idag
1789            begin            begin
# Line 1989  begin Line 1976  begin
1976      01 :      01 :
1977            begin;      // NS            begin;      // NS
1978              Testprinter1.Visible := true;              Testprinter1.Visible := true;
1979              DownloadButton01.Enabled := true;              BtnDownloadKontrolfil.Enabled := true;
1980              OpdaterListenButton01.Enabled := true;              OpdaterListenButton01.Enabled := true;
1981              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1982              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
# Line 2005  begin Line 1992  begin
1992              Storepakker1.Enabled := true;              Storepakker1.Enabled := true;
1993              radioStorPakke.Enabled := true;              radioStorPakke.Enabled := true;
1994              radioLillePakke.Enabled := true;              radioLillePakke.Enabled := true;
1995              DownloadButton01.Enabled := false;     // kontrolfil bruges ikke her              BtnDownloadKontrolfil.Enabled := false;     // kontrolfil bruges ikke her
1996              OpdaterListenButton01.Enabled := true;              OpdaterListenButton01.Enabled := true;
1997              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1998              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
# Line 2022  begin Line 2009  begin
2009              begin              begin
2010                DownloadButton03.Visible := false;                DownloadButton03.Visible := false;
2011              end;              end;
2012              DownloadButton01.Enabled := true;              BtnDownloadKontrolfil.Enabled := true;
2013              OpdaterListenButton01.Enabled := true;              OpdaterListenButton01.Enabled := true;
2014              IdFTP1.Passive := true;              IdFTP1.Passive := true;
2015              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
# Line 2043  begin Line 2030  begin
2030              Storepakker1.Enabled := true;              Storepakker1.Enabled := true;
2031              radioStorPakke.Enabled := true;              radioStorPakke.Enabled := true;
2032              radioLillePakke.Enabled := true;              radioLillePakke.Enabled := true;
2033              DownloadButton01.Enabled := false;    // kontrolfil bruges ikke her              BtnDownloadKontrolfil.Enabled := false;    // kontrolfil bruges ikke her
2034              OpdaterListenButton01.Enabled := true;              OpdaterListenButton01.Enabled := true;
2035              IdFTP1.Passive := true;              IdFTP1.Passive := true;
2036              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
# Line 2060  var Line 2047  var
2047    URLStr : String;    URLStr : String;
2048    pakkestorrelse : String;    pakkestorrelse : String;
2049    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
2050    
2051      PakkeshopLabel: TPakkeshopLabel;
2052  begin  begin
2053    if radioStorPakke.Checked then    if radioStorPakke.Checked then
2054    begin    begin
# Line 2069  begin Line 2058  begin
2058    begin    begin
2059      pakkestorrelse := 'Lille';      pakkestorrelse := 'Lille';
2060    end;    end;
2061    
2062    
2063    if Pakkernormal1.Checked then    if Pakkernormal1.Checked then
2064    begin    begin
2065       if (BoghandlerTjekkode = '') then       if (BoghandlerTjekkode = '') then
# Line 2097  begin Line 2088  begin
2088    begin    begin
2089       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);
2090    end    end
2091      else if menuIndlevering.Checked then
2092      begin
2093        URLStr := Format(UrlIndleveringsPakke,[Sted, PakkeNr]);
2094      end
2095    else    else
2096    begin    begin
2097      exit;      exit;
# Line 2143  begin Line 2138  begin
2138          begin          begin
2139            PrintNyLabel := True;            PrintNyLabel := True;
2140          end;          end;
 // 20150310: start  
2141        end;        end;
 // 20150310: slut  
2142       end       end
2143        else if menuIndlevering.Checked then
2144        begin
2145    
2146    
2147    
2148    
2149         Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text;
2150         if (Kommentar = 'Ok') then
2151         begin
2152           PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2153           PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2154           RuteNummer := PakkeshopLabel.Koreliste;
2155    
2156           PrintPakkeshopLabel( PakkeshopLabel );
2157    
2158         end;
2159    
2160    
2161        end
2162      else      else
2163       begin       begin
2164        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
# Line 2179  begin Line 2191  begin
2191          PrintNyLabel := True;          PrintNyLabel := True;
2192        end;        end;
2193      end;      end;
2194    
2195    
2196      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
2197      begin      begin
2198        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
# Line 2293  pakkeForkertSted : Integer; Line 2307  pakkeForkertSted : Integer;
2307    nytRuteNummer, nyFarve : String;    nytRuteNummer, nyFarve : String;
2308  begin  begin
2309    if Budlevering1.Checked then    if Budlevering1.Checked then
2310       RuteNummerST.Color := HexToTColor(Farve);       RuteNummerST.Color := TUtils.HexToTColor(Farve);
2311    
2312    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
2313    if pakkeErScannet = 0 then    if pakkeErScannet = 0 then
# Line 2338  begin Line 2352  begin
2352    
2353          PlaySound(PWideChar(AlarmLyd));          PlaySound(PWideChar(AlarmLyd));
2354          MainForm.Color := clRed;          MainForm.Color := clRed;
2355          PakkeshopNulstil.Visible := true;          btnNulstil.Visible := true;
2356    
2357       end       end
2358       else       else
# Line 2349  begin Line 2363  begin
2363            PrintNyLabel := true;            PrintNyLabel := true;
2364            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
2365            nyFarve := Farve;            nyFarve := Farve;
2366            RuteNummerST.Color := HexToTColor(nyFarve);            RuteNummerST.Color := TUtils.HexToTColor(nyFarve);
2367            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
2368            RuteNummer := nytRuteNummer;            RuteNummer := nytRuteNummer;
2369            ListBox1.Items.Insert(0,List1Msg);            ListBox1.Items.Insert(0,List1Msg);
# Line 2365  begin Line 2379  begin
2379            begin            begin
2380              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2381              MainForm.Color := clRed;              MainForm.Color := clRed;
2382              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2383            end;            end;
2384    
2385         end;         end;
# Line 2391  begin Line 2405  begin
2405            begin            begin
2406              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2407              MainForm.Color := clRed;              MainForm.Color := clRed;
2408              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2409            end;            end;
2410    
2411         end;         end;
# Line 2415  begin Line 2429  begin
2429                end;                end;
2430              end;              end;
2431        01 :  begin;        01 :  begin;
2432               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2433                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
2434                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
2435                begin                begin
# Line 2429  begin Line 2443  begin
2443                end;                end;
2444              end;              end;
2445        03 :  begin;        03 :  begin;
2446               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2447                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste                    // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
2448                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')                    // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
2449               begin               begin
# Line 2640  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 2669  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 2697  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 2725  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 2753  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 2781  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 2810  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 2838  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 2866  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 2891  begin Line 2905  begin
2905            end;            end;
2906          end;          end;
2907    
2908           // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger
2909            if PanelValg7.Enabled = true then
2910            begin
2911              if TUtils.CheckUrl(UrlIndleveringsPakke) then
2912              begin
2913                logTekst := 'UrlIndleveringsPakke accepteret: ' + UrlIndleveringsPakke;
2914                SkrivScanningLogFil(logTekst);
2915              end
2916              else
2917              begin
2918                inc(urlFejl);   // Optæller antal fejl
2919                logTekst := 'UrlIndleveringsPakke svarer ikke: ' + UrlIndleveringsPakke;
2920                ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2921                if TjekUrls = '1' then
2922                begin
2923                  logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';
2924                end;
2925                SkrivScanningLogFil(logTekst);
2926                if TjekUrls = '1' then
2927                begin
2928                  ShowMessage(logTekst);
2929                  UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut
2930                  Application.Terminate;
2931                  exit;
2932                end;
2933              end;
2934    
2935              if TUtils.CheckUrl(UrlIndleveringsPakkeManglendeScanninger) then
2936              begin
2937                logTekst := 'UrlIndleveringsPakkeManglendeScanninger accepteret: ' + UrlIndleveringsPakkeManglendeScanninger;
2938                SkrivScanningLogFil(logTekst);
2939              end
2940              else
2941              begin
2942                inc(urlFejl);   // Optæller antal fejl
2943                logTekst := 'UrlIndleveringsPakkeManglendeScanninger svarer ikke: ' + UrlIndleveringsPakkeManglendeScanninger;
2944                ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2945                if TjekUrls = '1' then
2946                begin
2947                  logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';
2948                end;
2949                SkrivScanningLogFil(logTekst);
2950                if TjekUrls = '1' then
2951                begin
2952                  ShowMessage(logTekst);
2953                  UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut
2954                  Application.Terminate;
2955                  exit;
2956                end;
2957              end;
2958            end;
2959    
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 2923  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 2950  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 2975  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 3038  begin Line 3104  begin
3104      repeat      repeat
3105        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
3106        begin        begin
3107    
3108          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
3109          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
3110          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
# Line 3077  begin Line 3144  begin
3144    end;    end;
3145  end;  end;
3146    
3147  procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);  procedure TMainForm.btnNulstilClick(Sender: TObject);
3148  begin  begin
3149    PakkeshopStregkode := '';    PakkeshopStregkode := '';
3150    PakkeshopTjekkode := '';    PakkeshopTjekkode := '';
3151    PakkeshopNulstil.Visible := false;    btnNulstil.Visible := false;
3152    PakkeshopText1.Caption := 'Stregkode';    PakkeshopText1.Caption := 'Stregkode';
3153    BoghandlerStregkode := '';    BoghandlerStregkode := '';
3154    BoghandlerTjekkode := '';    BoghandlerTjekkode := '';
# Line 3099  begin Line 3166  begin
3166  //  MainForm.Color := HexToTColor(Farve);  //  MainForm.Color := HexToTColor(Farve);
3167    if Farve <> '' then    if Farve <> '' then
3168    begin    begin
3169       MainForm.Color := HexToTColor(Farve);       MainForm.Color := TUtils.HexToTColor(Farve);
3170  // 20150312: start  // 20150312: start
3171  (*  (*
3172    end    end
# Line 3173  end; Line 3240  end;
3240    
3241  procedure TMainForm.PanelValgAClick(Sender: TObject);  procedure TMainForm.PanelValgAClick(Sender: TObject);
3242  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;  
 *)  
3243  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
3244  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
3245       AutomatiskValg1.Checked := true;    AutomatiskValg1.Checked := true;
3246       PanelValgA.Color := clGreen;    PanelValgA.Color := clGreen;
3247       PanelValgA.Font.Color := clWhite;    PanelValgA.Font.Color := clWhite;
3248  // 20150311: slut  
3249    
3250    
3251  end;  end;
3252    
3253  procedure TMainForm.Pakkernormal1Click(Sender: TObject);  procedure TMainForm.Pakkernormal1Click(Sender: TObject);
# Line 3231  begin Line 3285  begin
3285      // Her kommer en alarm og rød skærm      // Her kommer en alarm og rød skærm
3286      PlaySound(PWideChar(AlarmLyd));      PlaySound(PWideChar(AlarmLyd));
3287      MainForm.Color := clRed;      MainForm.Color := clRed;
3288      PakkeshopNulstil.Visible := true;      btnNulstil.Visible := true;
3289    end    end
3290    else    else
3291    begin    begin
# Line 3299  begin Line 3353  begin
3353    end;    end;
3354  end;  end;
3355    
3356  {  
  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;  
3357    
3358  procedure TMainForm.Om1Click(Sender: TObject);  procedure TMainForm.Om1Click(Sender: TObject);
3359  const  const
# Line 3337  var Line 3362  var
3362   tekst, filversion : String;   tekst, filversion : String;
3363  begin  begin
3364    
3365    filversion := Sto_GetFmtFileVersion('','');    filversion := TUtils.Sto_GetFmtFileVersion('');
3366    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';
3367    
3368    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3359  begin Line 3384  begin
3384          end          end
3385          else          else
3386          begin          begin
3387            tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
3388          end;          end;
3389      end      end
3390      else      else
3391      begin      begin
3392        tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';        tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
3393      end;      end;
3394    end;    end;
3395    
# Line 3432  begin Line 3457  begin
3457    
3458    if FileExists(fileName) then    if FileExists(fileName) then
3459    begin    begin
3460      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3461      begin      begin
3462        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3463        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
# Line 3456  begin Line 3481  begin
3481    
3482    if FileExists(fileName) then    if FileExists(fileName) then
3483    begin    begin
3484      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3485      begin      begin
3486        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3487        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
# Line 3472  begin Line 3497  begin
3497    end;    end;
3498  end;  end;
3499    
3500    procedure TMainForm.menuIndleveringClick(Sender: TObject);
3501    begin
3502      Scanningtype := '7';
3503      NulstilAutomatiskValg();
3504      InitIndleveringskode();
3505    end;
3506    
3507  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
3508  begin  begin
3509    
# Line 3504  end; Line 3536  end;
3536  procedure TMainForm.InitNatxpresslevering();  procedure TMainForm.InitNatxpresslevering();
3537  begin  begin
3538        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3539        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3540        Pakkernormal1.Checked := true;        Pakkernormal1.Checked := true;
3541        InitForm(FarveNormal,TitelNormal,UrlNormal);        InitForm(FarveNormal,TitelNormal,UrlNormal);
3542        PanelValg1.Color := clGreen;        PanelValg1.Color := clGreen;
# Line 3537  procedure TMainForm.InitReturFraDao(); Line 3569  procedure TMainForm.InitReturFraDao();
3569  begin  begin
3570        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3571        ReturpakkerfraDAO1.Checked := true;        ReturpakkerfraDAO1.Checked := true;
3572        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3573        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
3574        PanelValg2.Color := clGreen;        PanelValg2.Color := clGreen;
3575        PanelValg2.Font.Color := clWhite;        PanelValg2.Font.Color := clWhite;
# Line 3564  procedure TMainForm.InitReturFraKunde(); Line 3596  procedure TMainForm.InitReturFraKunde();
3596  begin  begin
3597        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3598        Returpakkerfraboghandler1.Checked := true;        Returpakkerfraboghandler1.Checked := true;
3599        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3600        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
3601        PanelValg3.Color := clGreen;        PanelValg3.Color := clGreen;
3602        PanelValg3.Font.Color := clWhite;        PanelValg3.Font.Color := clWhite;
# Line 3590  procedure TMainForm.InitDirektelevering( Line 3622  procedure TMainForm.InitDirektelevering(
3622  begin  begin
3623        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3624        Budlevering1.Checked := true;        Budlevering1.Checked := true;
3625        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3626        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
3627        PanelValg4.Color := clGreen;        PanelValg4.Color := clGreen;
3628        PanelValg4.Font.Color := clWhite;        PanelValg4.Font.Color := clWhite;
# Line 3608  begin Line 3640  begin
3640        radioLillePakke.Enabled := true;        radioLillePakke.Enabled := true;
3641        ListBox1.Visible := true;        ListBox1.Visible := true;
3642        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3643        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3644        OpdaterListenButton01.Enabled := true;        OpdaterListenButton01.Enabled := true;
3645        DownloadButton03.Visible := false;        DownloadButton03.Visible := false;
3646        EKLoverforsel.Enabled := false;        EKLoverforsel.Enabled := false;
# Line 3626  procedure TMainForm.InitPakkeshopleverin Line 3658  procedure TMainForm.InitPakkeshopleverin
3658  begin  begin
3659        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3660        Pakkeshoplevering1.Checked := true;        Pakkeshoplevering1.Checked := true;
3661        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3662        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
3663        PanelValg5.Color := clGreen;        PanelValg5.Color := clGreen;
3664        PanelValg5.Font.Color := clWhite;        PanelValg5.Font.Color := clWhite;
# Line 3644  begin Line 3676  begin
3676        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3677        ListBox1.Visible := true;        ListBox1.Visible := true;
3678        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3679        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3680        OpdaterListenButton01.Enabled := true;        OpdaterListenButton01.Enabled := true;
3681    
3682        EKLoverforsel.Enabled := true;        EKLoverforsel.Enabled := true;
# Line 3663  procedure TMainForm.InitReturFraPakkesho Line 3695  procedure TMainForm.InitReturFraPakkesho
3695  begin  begin
3696        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3697        Returpakkerfrapakkeshop1.Checked := true;        Returpakkerfrapakkeshop1.Checked := true;
3698        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3699        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
3700        PanelValg6.Color := clGreen;        PanelValg6.Color := clGreen;
3701        PanelValg6.Font.Color := clWhite;        PanelValg6.Font.Color := clWhite;
# Line 3681  begin Line 3713  begin
3713        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3714        ListBox1.Visible := true;        ListBox1.Visible := true;
3715        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3716        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3717        OpdaterListenButton01.Enabled := true;        OpdaterListenButton01.Enabled := true;
3718        EKLoverforsel.Enabled := false;        EKLoverforsel.Enabled := false;
3719        InitLillePakke();        InitLillePakke();
# Line 3703  end; Line 3735  end;
3735    
3736  procedure TMainForm.InitIndleveringskode();  procedure TMainForm.InitIndleveringskode();
3737  begin  begin
3738          menuIndlevering.Checked := true;
3739        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3740        Returpakkerfrapakkeshop1.Checked := true;  
3741        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3742        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
3743        PanelValg7.Color := clGreen;        PanelValg7.Color := clGreen;
3744        PanelValg7.Font.Color := clWhite;        PanelValg7.Font.Color := clWhite;
# Line 3727  begin Line 3760  begin
3760        ListBox1.Visible := true;        ListBox1.Visible := true;
3761        ListBox1.Items.Clear();        ListBox1.Items.Clear();
3762    
3763        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3764        OpdaterListenButton01.Enabled := true;        OpdaterListenButton01.Enabled := true;
3765        EKLoverforsel.Enabled := false;        EKLoverforsel.Enabled := false;
3766        InitLillePakke();        InitLillePakke();
# Line 3767  begin Line 3800  begin
3800  // 20150310: slut  // 20150310: slut
3801  end;  end;
3802    
 /// <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 = '';  
   const Fmt: String = '%d.%d.%d.%d'): String;  
 var  
   sFileName: String;  
   iBufferSize: DWORD;  
   iDummy: DWORD;  
   pBuffer: Pointer;  
   pFileInfo: Pointer;  
   iVer: array[1..4] of Word;  
   S : String;  
 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(Fmt, [iVer[1], iVer[2], iVer[3], iVer[4]]);  
3803    
     // Hvorfor virker ovenstående ikke ???  
     S := '';  
     Str(iVer[1], Result);  
     S := S+Result+'.';  
     Str(iVer[2], Result);  
     S := S+Result+'.';  
     Str(iVer[3], Result);  
     S := S+Result+'.';  
     Str(iVer[4], Result);  
     S := S+Result+'';  
     Result := S;  
   end;  
 end;  
3804    
3805  procedure TMainForm.PlaySound(filename : PWideChar);  procedure TMainForm.PlaySound(filename : PWideChar);
3806  begin  begin
# Line 3993  begin Line 3961  begin
3961           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
3962         end;         end;
3963         KommentarST.Caption := Kommentar;         KommentarST.Caption := Kommentar;
3964         PakkeshopNulstil.Visible := true;         btnNulstil.Visible := true;
3965      end;      end;
3966    
3967  end;  end;
# Line 4017  begin Line 3985  begin
3985    else    else
3986      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
3987  }  }
3988    Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;    Svar := 'Beregnet: ' + TUtils.CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
3989    
3990    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
3991    CheckCode();    CheckCode();
# Line 4025  end; Line 3993  end;
3993    
3994  end;  end;
3995    
 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;  
3996    
3997  //  //
3998  // Bladhus ***  // Bladhus ***
# Line 4541  begin Line 4470  begin
4470    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
4471  end;  end;
4472    
4473  procedure TMainForm.DownloadButton01Click(Sender: TObject);  procedure TMainForm.BtnDownloadKontrolfilClick(Sender: TObject);
4474  begin  begin
4475      DownloadBladhusKontrolfil();      DownloadBladhusKontrolfil();
4476      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
# Line 4565  begin Line 4494  begin
4494      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
4495  end;  end;
4496    
4497  function TMainForm.Explode(var a: TStrArray; Border, S: string): Integer;  
4498    // ToDo: PrintPakkeshopLabel()
4499    procedure TMainForm.PrintPakkeshopLabel( PakkeshopLabel : TPakkeshopLabel);
4500  var  var
4501    S2: string;    XForm, XFormOld: TXForm; //Bruges til rotate X-formation
4502      Angle: integer;
4503      gMode: integer;
4504      Dirigering: string;
4505    
4506    begin
4507        with Printer do
4508        begin
4509          BeginDoc();
4510    
4511    
4512          Canvas.Font.Size := 16;
4513          Canvas.TextOut(15,10, 'Code: ' + PakkeshopLabel.Tjekkode + '     '  + PakkeshopLabel.Overskrift);
4514    
4515    
4516    
4517          Canvas.TextOut(25, 90, PakkeshopLabel.Navn );
4518          Canvas.TextOut(25, 135, PakkeshopLabel.Vejnavn );
4519          Canvas.TextOut(25, 180, PakkeshopLabel.Postnr );
4520    
4521    
4522          Canvas.Font.Size := 9;
4523          Canvas.TextOut(110, 240, 'Pakkeshop:');
4524          Canvas.TextOut(110, 270, PakkeshopLabel.PakkeshopNavn);
4525          Canvas.TextOut(110, 300, PakkeshopLabel.PakkeshopAddr);
4526          Canvas.TextOut(110, 330, PakkeshopLabel.PakkeshopPostnr);
4527    
4528          Canvas.TextOut(350, 240, 'Afsender:');
4529          Canvas.TextOut(350, 270, PakkeshopLabel.AfsenderNavn);
4530          Canvas.TextOut(350, 300, PakkeshopLabel.AfsenderAdresse);
4531          Canvas.TextOut(350, 330, PakkeshopLabel.AfsenderPostnr);
4532    
4533          Dirigering := PakkeshopLabel.PakkeshopSted + ' | ' + PakkeshopLabel.PakkeshopTurid + ' | ' + PakkeshopLabel.PakkeshopNr;
4534          if ( PakkeshopLabel.Koreliste <> '') then
4535          begin
4536            Dirigering := Dirigering + ' > ' + PakkeshopLabel.Koreliste;
4537          end;
4538    
4539    
4540          Canvas.Font.Size := 12;
4541          Canvas.TextOut(15, 370, Dirigering);
4542    
4543    
4544    
4545    
4546    
4547          //Tegn adskillelses linier
4548          Canvas.Pen.Width := 2;
4549          //Øverste linie
4550          Canvas.MoveTo(20,80);
4551          Canvas.LineTo(600,80);
4552    
4553          // Midterste linie
4554          Canvas.MoveTo( 20, 240);
4555          Canvas.LineTo(600, 240);
4556    
4557          //Nederste linie
4558          Canvas.MoveTo( 20, 370);
4559          Canvas.LineTo(600, 370);
4560    
4561    
4562          //Tegn skrå streger over afsender
4563          Canvas.Pen.Width := 1;
4564          Canvas.MoveTo(600, 250);
4565          Canvas.LineTo(350, 360);
4566          Canvas.MoveTo(600, 360);
4567          Canvas.LineTo(350, 250);
4568    
4569    
4570    
4571    
4572          // Resten af rutinen vedr genering og placering af Barcode
4573    
4574          BarCode.BarCodeType := bcCode128;
4575          BarCode.Code128Subset := csCodeC;
4576          BarCode.Code := PakkeshopLabel.Stregkode;
4577          BarCode.Validate(True);
4578    
4579          //Start X-formation
4580          //ShowMessage( Format('%d %d', [PageWidth, PageHeight]) );
4581          GetWorldTransform(Canvas.Handle, XFormOld);
4582    
4583          Angle := 270;
4584          XForm.eM11 := Cos(DegToRad(Angle));
4585          XForm.eM12 := Sin(DegToRad(Angle));
4586          XForm.eM21 := -Sin(DegToRad(Angle));
4587          XForm.eM22 := Cos(DegToRad(Angle));
4588          XForm.eDx := 0;
4589          XForm.eDy := 0;
4590    
4591          gMode := SetGraphicsMode(Canvas.Handle, GM_ADVANCED);
4592          SetWorldTransform(Canvas.Handle, XForm);
4593    
4594          // PaintToCanvasSize arbejder i Inches
4595          // Første pos argument bliver nu Y og skal være negativ for at rykke den ned
4596          //Anden pos er X og skal være positiv for at justere ind fra venstre mod højre
4597    
4598          BarCode.PaintToCanvasSize(Printer.Canvas, -1.8, 3.3, 0.4);
4599    
4600    
4601          SetWorldTransform(Canvas.Handle, XFormOld);
4602          SetGraphicsMode(Canvas.Handle, gMode);
4603    
4604          EndDoc();
4605        end;
4606    
4607    
4608    end;
4609    
4610    function GetPixelsPerInchX(): Integer;
4611  begin  begin
4612    Result  := 0;    Result := GetDeviceCaps(Printer.Handle, LOGPIXELSX)
   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 = '';  
4613  end;  end;
4614    
4615    function GetPixelsPerInchY(): Integer;
4616    begin
4617      Result := GetDeviceCaps(Printer.Handle, LOGPIXELSY)
4618    end;
4619    
4620    
4621  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4622  var  var
4623    WebSvar : String;    WebSvar : String;
# Line 4614  var Line 4653  var
4653        end;        end;
4654    
4655    
4656      if (Scanningtype = '6') then  
4657        if (Scanningtype = '7') then
4658         begin
4659          URLStr := Format(UrlIndleveringsPakkeManglendeScanninger, [StedKode]);
4660         end
4661        else if (Scanningtype = '6') then
4662       begin       begin
4663        URLStr := Format(UrlPakkeshopManglendeReturScanninger,[StedKode]);        URLStr := Format(UrlPakkeshopManglendeReturScanninger, [StedKode]);
4664       end       end
4665      else if (Scanningtype = '5') then      else if (Scanningtype = '5') then
4666       begin       begin
4667        URLStr := Format(UrlPakkeshopManglendeScanninger,[StedKode]);        URLStr := Format(UrlPakkeshopManglendeScanninger, [StedKode]);
4668       end       end
4669      else if (Scanningtype = '1') then      else if (Scanningtype = '1') then
4670       begin       begin
# Line 4744  var Line 4788  var
4788  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  //                    stregkoderMedTjekkodeArray[linienr] := stregkode;
4789                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4790                    begin                    begin
4791                      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
4792                    end                    end
4793                    else                    else
4794                    begin                    begin
# Line 4934  var Line 4978  var
4978     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
4979     imorgenYmd : string;     imorgenYmd : string;
4980     logFilnavn : string;     logFilnavn : string;
4981      error : Integer;     //error : Integer;
4982    
4983  begin  begin
4984    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5026  begin Line 5070  begin
5070          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5071          S := buffer;          S := buffer;
5072          SetLength(A,0);          SetLength(A,0);
5073          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5074          if (length(A) < 2) then          if (length(A) < 2) then
5075          begin          begin
5076            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5077          end;          end;
5078            if (length(A) > 1) then            if (length(A) > 1) then
5079            begin            begin
# Line 5103  begin Line 5147  begin
5147          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
5148          S := buffer;          S := buffer;
5149          SetLength(A,0);          SetLength(A,0);
5150          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
5151          if (length(A) < 3) then          if (length(A) < 3) then
5152          begin          begin
5153            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
5154          end;          end;
5155          if (A[0]=imorgenYmd) then          if (A[0]=imorgenYmd) then
5156          begin          begin
# Line 5203  begin Line 5247  begin
5247    //ShowMessage('Ændring ikke tilladt');    //ShowMessage('Ændring ikke tilladt');
5248    // Her skal komme en 'rød skærm' alarm    // Her skal komme en 'rød skærm' alarm
5249    PlaySound(PWideChar(AlarmLyd));    PlaySound(PWideChar(AlarmLyd));
   
   ListBox1.Items.Insert(0, strMessage);  
5250    MainForm.Color := clRed;    MainForm.Color := clRed;
5251    
5252    
5253    RuteNummerST.Caption := '';    RuteNummerST.Caption := '';
5254    BoghandlerNavnST.Caption := '';    BoghandlerNavnST.Caption := '';
5255    KommentarST.Caption := strMessage;    btnNulstil.Visible := true;
5256    PakkeshopNulstil.Visible := true;  
5257      if (strMessage <> '') then
5258      begin
5259        ListBox1.Items.Insert(0, strMessage);
5260        KommentarST.Caption := strMessage;
5261      end;
5262    
5263  end;  end;
5264    
5265  function TMainForm.getProddato() : TDate;  function TMainForm.getProddato() : TDate;
# Line 5301  begin Line 5351  begin
5351    end;    end;
5352  end;  end;
5353    
5354  function TMainForm.AdobeReaderExists: Boolean;  
5355  var  
5356    AReg: TRegistry;  
5357  begin  
5358    result:= false;  
   AReg := TRegistry.Create;  
   AReg.RootKey := HKEY_LOCAL_MACHINE;  
   if AReg.KeyExists('\SOFTWARE\Adobe\Acrobat Reader') then  
     result:= True;  
   AReg.Free;  
 end;  
5359    
5360  procedure TMainForm.CheckPrintQue(tjektype : string);  procedure TMainForm.CheckPrintQue(tjektype : string);
5361  type  type
# Line 5416  begin Line 5460  begin
5460    end;    end;
5461  end;  end;
5462    
 function TMainForm.CheckUrl(url:string):boolean;  
 var  
   hSession, hfile, hRequest: 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;  
   
 end;  
   
 // 20150310: start  
 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;  
 // 20150310: slut  
5463    
5464  end.  end.
5465    
Legend:
Removed from v.2660  
changed lines
  Added in v.2694
  ViewVC Help
Powered by ViewVC 1.1.20