/[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 2792 by torben, Sun Dec 6 15:23:50 2015 UTC
# Line 1  Line 1 
1  unit Main;  unit Main;
2    
3    // ToDo: flyt PrinterNavn til hhv Configuration lg lad TLabelPrint om al håndtering heraf
4    // ToDo: flyt flere parametre til TConfiguration
5    
6    // ToDo: FormKeyPress() trænger til en seriøs oprydning / refactoring
7    // ToDo: flyt mere funktionalitet fra interface layer til application layer klasser
8    // ToDo: vil det give mening at bruge State Pattern ? Så der er en class per scanningstype ?
9    // ToDo: alternativt kan man bruge en Enum til de forskellige typer
10    // ToDo: en enklere måde at håndtere capabilities på de forskellige scannings steder
11    
12    
13  interface  interface
14    
15  uses  uses
16    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,    Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
17    Dialogs, StdCtrls, Printers, IdBaseComponent, IdComponent, IdTCPConnection,    Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
18    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,    IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,
19    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,    Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,
20    IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,    IdExplicitTLSClientServerBase, IdFTP, IdException,
21    Winspool, Registry, ShellApi, ClipBrd, Buttons, wininet,    ShellApi, ClipBrd, Buttons, wininet,
22    UITypes    UITypes,
23      PakkeshopLabels,
24      Utils,
25      ParentForm,
26      LabelPrint,
27      Configuration,
28      Vcl.Imaging.pngimage,
29      Generics.Collections
30    
31    ;    ;
32    
33  type  type
34    TStrArray = array of string;    TMainForm = class(TForm, IParentForm)
   TMainForm = class(TForm)  
35      StregkodeST: TStaticText;      StregkodeST: TStaticText;
36      RuteNummerST: TStaticText;      RuteNummerST: TStaticText;
37      BoghandlerNavnST: TStaticText;      BoghandlerNavnST: TStaticText;
# Line 49  type Line 65  type
65      Testlyd1: TMenuItem;      Testlyd1: TMenuItem;
66      ListBox1: TListBox;      ListBox1: TListBox;
67      Budlevering1: TMenuItem;      Budlevering1: TMenuItem;
68      DownloadButton01: TButton;      BtnDownloadKontrolfil: TButton;
69      IdFTP1: TIdFTP;      IdFTP1: TIdFTP;
70      Image1: TImage;      Image1: TImage;
71      ListBox2: TListBox;      ListBox2: TListBox;
72      OpdaterListenButton01: TButton;      BtnOpdaterListen: TButton;
73      UploadButton01: TButton;      BtnUploadLogfil: TButton;
74      DownloadButton03: TButton;      BtnDownloadRuteskiftFil: TButton;
75      Pakkeshoplevering1: TMenuItem;      Pakkeshoplevering1: TMenuItem;
76      PakkeshopText1: TStaticText;      PakkeshopText1: TStaticText;
77      PakkeshopNulstil: TButton;      btnNulstil: TButton;
78      Returpakkerfrapakkeshop1: TMenuItem;      Returpakkerfrapakkeshop1: TMenuItem;
79      Altidprintepakkelabel1: TMenuItem;      Altidprintepakkelabel1: TMenuItem;
80      chkAltidPrintLabel: TCheckBox;      chkAltidPrintLabel: TCheckBox;
81      EKLoverforsel: TButton;      BtnEKLoverforsel: TButton;
82      N5: TMenuItem;      N5: TMenuItem;
83      Uploadlogfil1: TMenuItem;      Uploadlogfil1: TMenuItem;
84      Manual1: TMenuItem;      Manual1: TMenuItem;
# Line 88  type Line 104  type
104      PanelManglendePakker4: TPanel;      PanelManglendePakker4: TPanel;
105      PanelManglendePakker5: TPanel;      PanelManglendePakker5: TPanel;
106      PanelManglendePakker6: TPanel;      PanelManglendePakker6: TPanel;
107        menuIndlevering: TMenuItem;
108        chkForstorTilDirekte: TCheckBox;
109    
110    
111    
   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;  
112    function getProddato() : TDate;    function getProddato() : TDate;
113    function getProddag() : String;    function getProddag() : String;
114    function retRutenummer(rutenummer : String) : String;    function retRutenummer(rutenummer : String) : String;
   function GetCurrentPrinterHandle() : THandle;  
   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;  
115    
116    procedure PlaySound(filename : PWideChar);    procedure PlaySound(filename : PWideChar);
117    procedure StartScreen();    procedure StartScreen();
# Line 134  type Line 142  type
142    procedure Button1Click(Sender: TObject);    procedure Button1Click(Sender: TObject);
143    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
144    procedure Budlevering1Click(Sender: TObject);    procedure Budlevering1Click(Sender: TObject);
145    procedure DownloadButton01Click(Sender: TObject);    procedure BtnDownloadKontrolfilClick(Sender: TObject);
146    procedure OpdaterListenButton01Click(Sender: TObject);    procedure BtnOpdaterListenClick(Sender: TObject);
147    procedure DownloadBladhusRuteskiftfil();    procedure DownloadBladhusRuteskiftfil();
148    procedure DownloadBladhusKontrolfil();    procedure DownloadBladhusKontrolfil();
149    procedure SendFilTilDAO(fil_type, filnavn_input, filnavn_output: String);    procedure SendFilTilDAO(fil_type, filnavn_input, filnavn_output: String);
# Line 143  type Line 151  type
151    procedure UploadInifilTilDAO();    procedure UploadInifilTilDAO();
152    procedure SletStregkodelinieFraListboks2(StregKode : String);    procedure SletStregkodelinieFraListboks2(StregKode : String);
153    procedure FormDestroy(Sender: TObject);    procedure FormDestroy(Sender: TObject);
154    procedure UploadButton01Click(Sender: TObject);    procedure BtnUploadLogfilClick(Sender: TObject);
155    procedure DownloadButton03Click(Sender: TObject);    procedure BtnDownloadRuteskiftFilClick(Sender: TObject);
156    procedure Pakkeshoplevering1Click(Sender: TObject);    procedure Pakkeshoplevering1Click(Sender: TObject);
157    procedure PakkeshopNulstilClick(Sender: TObject);    procedure btnNulstilClick(Sender: TObject);
158    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);    procedure Returpakkerfrapakkeshop1Click(Sender: TObject);
159    procedure InitNatxpresslevering();    procedure InitNatxpresslevering();
160    procedure InitReturFraDao();    procedure InitReturFraDao();
# Line 158  type Line 166  type
166    
167    procedure Altidprintepakkelabel1Click(Sender: TObject);    procedure Altidprintepakkelabel1Click(Sender: TObject);
168    procedure chkAltidPrintLabelClick(Sender: TObject);    procedure chkAltidPrintLabelClick(Sender: TObject);
169    procedure EKLoverforselClick(Sender: TObject);    procedure BtnEKLoverforselClick(Sender: TObject);
170    procedure Uploadlogfil1Click(Sender: TObject);    procedure Uploadlogfil1Click(Sender: TObject);
171    procedure Manual1Click(Sender: TObject);    procedure Manual1Click(Sender: TObject);
   procedure CheckPrintQue(tjektype : string);  
172    procedure Timer1Timer(Sender: TObject);    procedure Timer1Timer(Sender: TObject);
173    procedure Scanogstjekkoden1Click(Sender: TObject);    procedure Scanogstjekkoden1Click(Sender: TObject);
174    procedure chkScanTjekkodeClick(Sender: TObject);    procedure chkScanTjekkodeClick(Sender: TObject);
# Line 181  type Line 188  type
188    procedure SletLogfiler(Path: string; FileList: TStrings);    procedure SletLogfiler(Path: string; FileList: TStrings);
189    procedure Manualgenerel1Click(Sender: TObject);    procedure Manualgenerel1Click(Sender: TObject);
190    procedure TjekkerUrls();    procedure TjekkerUrls();
191  // 20150310: start    procedure TjekkerEnkeltUrl(UrlNavn: String; Url: String; var urlFejl: integer);
   procedure RoundCornerOf(Control: TWinControl);  
192    
193      procedure menuIndleveringClick(Sender: TObject);
194    
195    
196    
197    
198      //Nedarvet fra IParentForm
199      procedure LogMessage( msg : string);
200      procedure SetPrinterstatusText( txt: string; alert: boolean);
201      function GetFormObject() : TForm;
202    
 // 20150310: slut  
203    
204    private    private
205      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 207  type
207      SkrivLog : String;      SkrivLog : String;
208      Sted : String;      Sted : String;
209      StedNavn : String;      StedNavn : String;
210      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;
211  // 29150330: start  
212      UrlEKLoverforselPakkeshop : String;      UrlEKLoverforselPakkeshop : String;
213  // 20150330: slut  
214      UrlFindPakketype, UrlSendPrograminfo: String;      UrlFindPakketype, UrlSendPrograminfo: String;
215      Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;      Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;
216      ScanTjekkode : String;      ScanTjekkode : String;
217      ScanTjekkodeAutomatik : string;      ScanTjekkodeAutomatik : string;
218      Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;      Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;
219      Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;      Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;
220      LabelType : integer;  
221      AlarmLyd : String;      AlarmLyd : String;
222      ScannetOkLyd : String;      ScannetOkLyd : String;
223      ScannetOkStorLyd : String;      ScannetOkStorLyd : String;
224  // 20150317: start  
225      ScannetOkTilTjekkodeLyd : String;      ScannetOkTilTjekkodeLyd : String;
226  // 20150317: slut  
227      PrinterNavn : String;      PrinterNavn : String;
228      TjekPrinter : String;      TjekPrinter : String;
229      XPosRute : integer;  
     YPosRute : integer;  
     FontSizeRute : integer;  
     FontSizeRuteLille : integer;  
     XPosKommentar : integer;  
     YPosKommentar : integer;  
     FontSizeKommentar : integer;  
     XPosBoghandler : integer;  
     YPosBoghandler : integer;  
     FontSizeBoghandler : integer;  
     XPosKoreliste : integer;  
     YPosKoreliste : integer;  
     FontSizeKoreliste : integer;  
     FontSizeKorelisteLille : integer;  
     XPosSorteringsfelt1 : integer;  
     YPosSorteringsfelt1 : integer;  
     FontSizeSorteringsfelt1 : integer;  
     XPosSorteringsfelt2 : integer;  
     YPosSorteringsfelt2 : integer;  
     FontSizeSorteringsfelt2 : integer;  
     XPosSmskode : integer;  
     YPosSmskode : integer;  
     FontSizeSmskode : integer;  
230      Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;      Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;
231      BladhusSted : Integer;      BladhusSted : Integer;
232      BladhusStedKode : Array of string;      BladhusStedKode : Array of string;
# Line 247  type Line 239  type
239      PakkeshopStregkode, PakkeshopTjekkode : String;      PakkeshopStregkode, PakkeshopTjekkode : String;
240      BoghandlerStregkode, BoghandlerTjekkode : String;      BoghandlerStregkode, BoghandlerTjekkode : String;
241      TjekUrls : String;      TjekUrls : String;
242        Config : TConfiguration;
243    
244    
245            function CheckSumModulo10(const data:string):string;          { used for EAN 8/13 }      LabelPrint: TLabelPrint;
246    
247      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 = '');
248      procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  
249      procedure HentPakkeInfoFraServer(const Sted, PakkeNr : String; var RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel: Boolean; BoghandlerNummer : String = '');      procedure HentPakkeInfoFraServer(const Sted, PakkeNr : String; var RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel: Boolean; BoghandlerNummer : String = '');
250      procedure CheckCode();      procedure CheckCode();
251      procedure IndlesManglendeScanninger();      procedure IndlesManglendeScanninger();
# Line 266  type Line 260  type
260      { Public declarations }      { Public declarations }
261    end;    end;
262    
263    
264  var  var
265    MainForm: TMainForm;    MainForm: TMainForm;
266    
# Line 279  var Line 274  var
274  implementation  implementation
275  {$R *.dfm}  {$R *.dfm}
276    
277  function TMainForm.TColorToHex(Color : TColor) : string;  
278  begin  //FormCreate kaldes før InitForm
    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;  
279    
280  procedure TMainForm.InitForm(Farve,Titel,Url : String);  procedure TMainForm.InitForm(Farve,Titel,Url : String);
281  begin  begin
282    
 // 20150309: startr  
283      StaticTextManglendePakker.Caption := '';      StaticTextManglendePakker.Caption := '';
284  // 20150309: slut  
285    
286      PanelValg1.Color := clBtnFace;      PanelValg1.Color := clBtnFace;
287      if PanelValg1.Enabled = true then      if PanelValg1.Enabled = true then
# Line 346  begin Line 325  begin
325        PanelValg7.Font.Color := clWindowText;        PanelValg7.Font.Color := clWindowText;
326      end;      end;
327    
328      OpdaterListenButton01.Enabled := false;      BtnOpdaterListen.Enabled := false;
329    
330      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
331      begin      begin
# Line 400  begin Line 379  begin
379    
380      StartScreen();      StartScreen();
381      MainForm.Caption := Titel;      MainForm.Caption := Titel;
382      MainForm.Color := HexToTColor(Farve);      MainForm.Color := TUtils.HexToTColor(Farve);
383      MainForm.Farve := Farve;      MainForm.Farve := Farve;
384      MainForm.Titel := Titel;      MainForm.Titel := Titel;
385      MainForm.Url := Url;      MainForm.Url := Url;
# Line 460  begin Line 439  begin
439          end          end
440          else          else
441          begin          begin
442            logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
443          end;          end;
444          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
445        end        end
446        else        else
447        begin        begin
448          logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';          logTekst := 'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
449          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
450        end;        end;
451      end;      end;
452    
453    
454  end;  end;
455    
456  procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);  procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);
# Line 509  end; Line 489  end;
489    
490  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);  procedure TMainForm.Automatiskvalg1Click(Sender: TObject);
491  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;  
 *)  
492  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
493  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
494       AutomatiskValg1.Checked := true;       AutomatiskValg1.Checked := true;
495       PanelValgA.Color := clGreen;       PanelValgA.Color := clGreen;
496       PanelValgA.Font.Color := clWhite;       PanelValgA.Font.Color := clWhite;
 // 20150317: slut  
497  end;  end;
498    
499    
500    //InitForm kaldes før FormCreate
501  procedure TMainForm.FormCreate(Sender: TObject);  procedure TMainForm.FormCreate(Sender: TObject);
502  const  const
503    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
504  var  var
   printerInd : integer;  
505    gemScanningtype : String;    gemScanningtype : String;
506    
507  begin  begin
508    
509    
510    // Initierer nogle variabler    // Initierer nogle variabler
511    BladhusSted := 00;    BladhusSted := 00;
512    Application.ShowHint := True;    Application.ShowHint := True;
513    PrinterstatusStaticText1.Caption := '';    PrinterstatusStaticText1.Caption := '';
514    PrinterstatusStaticText1.Color := MainForm.Color;    PrinterstatusStaticText1.Color := MainForm.Color;
515    
516    PakkeshopNulstil.BringToFront;    btnNulstil.BringToFront;
517    
518    RoundCornerOf(PanelManglendePakker1);    TUtils.RoundCornerOf(PanelManglendePakker1);
519    RoundCornerOf(PanelManglendePakker2);    TUtils.RoundCornerOf(PanelManglendePakker2);
520    RoundCornerOf(PanelManglendePakker3);    TUtils.RoundCornerOf(PanelManglendePakker3);
521    RoundCornerOf(PanelManglendePakker4);    TUtils.RoundCornerOf(PanelManglendePakker4);
522    RoundCornerOf(PanelManglendePakker5);    TUtils.RoundCornerOf(PanelManglendePakker5);
523    RoundCornerOf(PanelManglendePakker6);    TUtils.RoundCornerOf(PanelManglendePakker6);
524    
525    
526    // 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 567  begin Line 534  begin
534    MainForm.ClientWidth := 1000;    MainForm.ClientWidth := 1000;
535    MainForm.ClientHeight := 750;    MainForm.ClientHeight := 750;
536    
537      Config := TConfiguration.Create();
538      Config.ReadFromInifile( TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) );    //ToDo: clean up duplicate ini ref
539      Config.Sted := Sted;
540    
541    // Læser parametre fra ini filen    // Læser parametre fra ini filen
542    with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do    with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
543    try    try
544    
545    
546      SkrivLog := ReadString('Settings','SkrivLog','0');      SkrivLog := ReadString('Settings','SkrivLog','0');
547      Sted := ReadString('Settings','Sted','');      Sted := ReadString('Settings','Sted','');
548      StedNavn := ReadString('Settings','Stednavn','');      StedNavn := ReadString('Settings','Stednavn','');
# Line 588  begin Line 561  begin
561      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');
562      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');
563      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');
564      LabelType := ReadInteger('Settings','LabelType',1);  
565    
566        UrlIndleveringsPakke := ReadString('Settings','UrlIndleveringsPakke','http://omdeling.info/webservices/pakkeshop/PakkekontrolIndleveringskode.php?sted=%s&pakkekode=%s');
567        UrlIndleveringsPakkeManglendeScanninger := ReadString('Settings', 'UrlIndleveringsPakkeManglendeScanninger','http://omdeling.info/webservices/pakkeshop/IndleveringsPakkeManglendeScanninger.php?sted=%s');
568    
569    
570    
571      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');      FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');
572      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');      TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');
573      FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');      FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');
# Line 625  begin Line 604  begin
604    
605      if (SkrivLog = '1') then      if (SkrivLog = '1') then
606      begin      begin
607        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);
608        try        try
609          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
610          Uploadlogfil1.Enabled := true;          Uploadlogfil1.Enabled := true;
611          UploadButton01.Enabled := true;          BtnUploadLogfil.Enabled := true;
612          logTekst := 'Programmet er installeret som: '+ParamStr(0);          logTekst := 'Programmet er installeret som: '+ParamStr(0);
613          SkrivScanningLogFil(logTekst);          SkrivScanningLogFil(logTekst);
614          // Oprydning i gamle logfiler          // Oprydning i gamle logfiler
# Line 647  begin Line 626  begin
626        PanelValgA.Font.Color := clWhite;        PanelValgA.Font.Color := clWhite;
627      end;      end;
628    
629      if LabelType = 0 then  
     begin  
        XPosRute := ReadInteger('RuteBred','XPos',1);  
        YPosRute := ReadInteger('RuteBred','YPos',1);  
        FontSizeRute := ReadInteger('RuteBred','FontSize',72);  
        FontSizeRuteLille := ReadInteger('RuteBred','FontSizeLille',20);  
        XPosKommentar := ReadInteger('KommentarBred','XPos',1);  
        YPosKommentar := ReadInteger('KommentarBred','YPos',250);  
        FontSizeKommentar := ReadInteger('KommentarBred','FontSize',16);  
        XPosBoghandler := ReadInteger('BoghandlerBred','XPos',1);  
        YPosBoghandler := ReadInteger('BoghandlerBred','YPos',400);  
        FontSizeBoghandler := ReadInteger('BoghandlerBred','FontSize',16);  
        XPosKoreliste := ReadInteger('KorelisteSmal','XPos',1);  
        YPosKoreliste := ReadInteger('KorelisteSmal','YPos',100);  
        FontSizeKoreliste := ReadInteger('KorelisteSmal','FontSize',72);  
        FontSizeKorelisteLille := ReadInteger('KorelisteSmal','FontSizeLille',20);  
        XPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','XPos',700);  
        YPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','YPos',100);  
        FontSizeSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','FontSize',16);  
        XPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','XPos',700);  
        YPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','YPos',150);  
        FontSizeSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','FontSize',16);  
        XPosSmskode := ReadInteger('SmskodeSmal','XPos',1);  
        YPosSmskode := ReadInteger('SmskodeSmal','YPos',300);  
        FontSizeSmskode := ReadInteger('SmskodeSmal','FontSize',32);  
     end  
     else  
     begin  
        XPosRute := ReadInteger('RuteSmal','XPos',1);  
        YPosRute := ReadInteger('RuteSmal','YPos',1);  
        FontSizeRute := ReadInteger('RuteSmal','FontSize',72);  
        FontSizeRuteLille := ReadInteger('RuteSmal','FontSizeLille',20);  
        XPosKommentar := ReadInteger('KommentarSmal','XPos',1);  
        YPosKommentar := ReadInteger('KommentarSmal','YPos',250);  
        FontSizeKommentar := ReadInteger('KommentarSmal','FontSize',16);  
        XPosBoghandler := ReadInteger('BoghandlerSmal','XPos',1);  
        YPosBoghandler := ReadInteger('BoghandlerSmal','YPos',400);  
        FontSizeBoghandler := ReadInteger('BoghandlerSmal','FontSize',16);  
        XPosKoreliste := ReadInteger('KorelisteSmal','XPos',1);  
        YPosKoreliste := ReadInteger('KorelisteSmal','YPos',100);  
        FontSizeKoreliste := ReadInteger('KorelisteSmal','FontSize',72);  
        FontSizeKorelisteLille := ReadInteger('KorelisteSmal','FontSizeLille',20);  
        XPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','XPos',700);  
        YPosSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','YPos',100);  
        FontSizeSorteringsfelt1 := ReadInteger('Sorteringsfelt1Smal','FontSize',16);  
        XPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','XPos',700);  
        YPosSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','YPos',150);  
        FontSizeSorteringsfelt2 := ReadInteger('Sorteringsfelt2Smal','FontSize',16);  
        XPosSmskode := ReadInteger('SmskodeSmal','XPos',1);  
        YPosSmskode := ReadInteger('SmskodeSmal','YPos',300);  
        FontSizeSmskode := ReadInteger('SmskodeSmal','FontSize',32);  
        if LabelType = 2 then // test på alm. printer kræver at XY-positionerne ganges med 3  
        begin  
           XPosRute := XPosRute * 3;  
           YPosRute := YPosRute * 3;  
           XPosKommentar := XPosKommentar * 3;  
           YPosKommentar := YPosKommentar * 3;  
           XPosBoghandler := XPosBoghandler * 3;  
           YPosBoghandler := YPosBoghandler * 3;  
           XPosKoreliste := XPosKoreliste * 3;  
           YPosKoreliste := YPosKoreliste * 3;  
           XPosSorteringsfelt1 := XPosSorteringsfelt1 * 3;  
           YPosSorteringsfelt1 := YPosSorteringsfelt1 * 3;  
           XPosSorteringsfelt2 := XPosSorteringsfelt2 * 3;  
           YPosSorteringsfelt2 := YPosSorteringsfelt2 * 3;  
           XPosSmskode := XPosSmskode * 3;  
           YPosSmskode := YPosSmskode * 3;  
        end;  
     end;  
630    
631      if SporgEfterBoghandler = '1' then      if SporgEfterBoghandler = '1' then
632      begin      begin
# Line 768  begin Line 679  begin
679      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)      //SpecialVersionSted := 'FD';  // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
680      // *************************** //      // *************************** //
681    
682    {$IfDef STED_BK}
683        SpecialVersionSted := 'BK';
684    {$EndIf}
685    {$IfDef STED_DBK}
686        SpecialVersionSted := 'DBK';
687    {$EndIf}
688    {$IfDef STED_FD}
689        SpecialVersionSted := 'FD';
690    {$EndIf}
691    {$IfDef STED_NS}
692        SpecialVersionSted := 'NS';
693    {$EndIf}
694    
695    
696      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '01';  // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
697      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)      //SpecialVersionSted := '02';  // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
698      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)      //SpecialVersionSted := '03';  // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
# Line 783  begin Line 708  begin
708      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)      // Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)
709      // ændrer vi Sted og Scanningtype her:      // ændrer vi Sted og Scanningtype her:
710    
 // 20150313: start  
711      if SpecialVersionSted = 'NS' then      if SpecialVersionSted = 'NS' then
712      begin      begin
713         SpecialVersionSted := '01';         SpecialVersionSted := '01';
# Line 794  begin Line 718  begin
718         SpecialVersionSted := '03';         SpecialVersionSted := '03';
719         SpecialVersionScanningtype := '4';         SpecialVersionScanningtype := '4';
720      end;      end;
 // 20150313: slut  
721    
722      if SpecialVersionSted = 'BK' then      if SpecialVersionSted = 'BK' then
723      begin      begin
# Line 805  begin Line 728  begin
728        PanelValg2.Font.Color := clInactiveCaption;        PanelValg2.Font.Color := clInactiveCaption;
729        PanelValg3.Enabled := false;        PanelValg3.Enabled := false;
730        PanelValg3.Font.Color := clInactiveCaption;        PanelValg3.Font.Color := clInactiveCaption;
731        PanelValg6.Enabled := false;        //PanelValg6.Enabled := false;
732        PanelValg6.Font.Color := clInactiveCaption;        //PanelValg6.Font.Color := clInactiveCaption;
733    
734       // her skal vi også disable de menupunkter BK ikke kan bruge       // her skal vi også disable de menupunkter BK ikke kan bruge
735        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
736        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
737        Returpakkerfrapakkeshop1.Enabled := false;  
738          //Returpakkerfrapakkeshop1.Enabled := false;
739    
740        if SpecialVersionScanningtype = 'A' then        if SpecialVersionScanningtype = 'A' then
741        begin        begin
742           Scanningtype := '1';           Scanningtype := '1';
# Line 834  begin Line 760  begin
760        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
761        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
762        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
763          PanelValg7.Enabled := false;
764          PanelValg7.Font.Color := clInactiveCaption;
765    
766       // her skal vi også disable de menupunkter DBK ikke kan bruge       // her skal vi også disable de menupunkter DBK ikke kan bruge
767        ReturpakkerfraDAO1.Enabled := false;        ReturpakkerfraDAO1.Enabled := false;
768        Returpakkerfraboghandler1.Enabled := false;        Returpakkerfraboghandler1.Enabled := false;
# Line 870  begin Line 799  begin
799        PanelValg5.Font.Color := clInactiveCaption;        PanelValg5.Font.Color := clInactiveCaption;
800        PanelValg6.Enabled := false;        PanelValg6.Enabled := false;
801        PanelValg6.Font.Color := clInactiveCaption;        PanelValg6.Font.Color := clInactiveCaption;
802          PanelValg7.Enabled := false;
803          PanelValg7.Font.Color := clInactiveCaption;
804       // 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
805    
806        Automatiskvalg1.Enabled := false;        Automatiskvalg1.Enabled := false;
# Line 965  begin Line 896  begin
896             RutenummerST.Caption := '';             RutenummerST.Caption := '';
897             BoghandlerNavnST.Caption := 'Fejl i urls';             BoghandlerNavnST.Caption := 'Fejl i urls';
898             KommentarST.Caption := 'Se log vinduet';             KommentarST.Caption := 'Se log vinduet';
899             PakkeshopNulstil.Visible := true;             btnNulstil.Visible := true;
900             exit;             exit;
901          end;          end;
902      end      end
# Line 1060  begin Line 991  begin
991      end;      end;
992    
993    
     if (PrinterNavn <> '') then  
     begin  
        printerInd := Printer.Printers.IndexOf(printerNavn);  
        if printerInd >= 0 then  
           Printer.PrinterIndex := printerInd;  
     end;  
994    
995      CheckPrintQue('Opstart');  
996        LabelPrint := TLabelPrint.Create( self, Config, PrinterNavn );
997        LabelPrint.CheckPrintQue('Opstart', PrinterNavn);
998    
999    finally    finally
1000      Free;      Free;
# Line 1134  begin Line 1061  begin
1061      Scanningtype := gemScanningtype;      Scanningtype := gemScanningtype;
1062    
1063      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');      SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
1064      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));      SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', TUtils.Sto_GetFmtFileVersion(''));
1065    
1066  end;  end;
1067    
# Line 1214  begin Line 1141  begin
1141    
1142      if StregKode = 'Nulstil' then      if StregKode = 'Nulstil' then
1143      begin      begin
1144         PakkeshopNulstil.Click();         btnNulstil.Click();
1145         exit;         exit;
1146      end;      end;
1147    
1148      if PakkeshopNulstil.Visible then      if btnNulstil.Visible then
1149      begin      begin
1150        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );        VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );
1151    
# Line 1452  begin Line 1379  begin
1379        Pakkescanningtype := Scanningtype;        Pakkescanningtype := Scanningtype;
1380      end;      end;
1381    
1382      if (   (Pakkescanningtype = '1') and (PanelValg1.Enabled = false)      if (   ( (Pakkescanningtype = '1') and (PanelValg1.Enabled = false) )
1383          or (Pakkescanningtype = '2') and (PanelValg2.Enabled = false)          or ( (Pakkescanningtype = '2') and (PanelValg2.Enabled = false) )
1384          or (Pakkescanningtype = '3') and (PanelValg3.Enabled = false)          or ( (Pakkescanningtype = '3') and (PanelValg3.Enabled = false) )
1385          or (Pakkescanningtype = '4') and (PanelValg4.Enabled = false)          or ( (Pakkescanningtype = '4') and (PanelValg4.Enabled = false) )
1386          or (Pakkescanningtype = '5') and (PanelValg5.Enabled = false)          or ( (Pakkescanningtype = '5') and (PanelValg5.Enabled = false) )
1387          or (Pakkescanningtype = '6') and (PanelValg6.Enabled = false)  ) then          or ( (Pakkescanningtype = '6') and (PanelValg6.Enabled = false) ) ) then
1388      begin   // Her skal komme en alarm og rød skærm      begin   // Her skal komme en alarm og rød skærm
1389          VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );          VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
1390    
1391         exit;         exit;
1392      end;      end;
1393    
1394      if Automatiskvalg1.Checked and (Length(Stregkode) > 8) then      if (Automatiskvalg1.Checked and (Length(Stregkode) > 8) ) then
1395      begin      begin
1396        GemStregkode := Stregkode;        GemStregkode := Stregkode;
1397        if Pakketype = 'NatXpress' then        if Pakketype = 'NatXpress' then
# Line 1498  begin Line 1425  begin
1425        else        else
1426            begin            begin
1427            // Her skal komme en alarm og rød skærm            // Her skal komme en alarm og rød skærm
1428              VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );              //VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
1429                 VisAlarmSkaerm( Stregkode + ' kan ikke bruges med automatisk valg' );
1430    
1431               exit;               exit;
1432            end;            end;
# Line 1543  begin Line 1471  begin
1471             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1472             BoghandlerTjekkode := '';             BoghandlerTjekkode := '';
1473             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1474             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1475             Stregkode := '';             Stregkode := '';
1476             InitScreen();             InitScreen();
1477        end        end
# Line 1555  begin Line 1483  begin
1483             BoghandlerStregkode := Stregkode;             BoghandlerStregkode := Stregkode;
1484             BoghandlerTjekkode := '-1';             BoghandlerTjekkode := '-1';
1485             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1486             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1487             Stregkode := '';             Stregkode := '';
1488             InitScreen();             InitScreen();
1489        end        end
# Line 1586  begin Line 1514  begin
1514             BoghandlerTjekkode := Stregkode;             BoghandlerTjekkode := Stregkode;
1515             PakkeshopText1.Caption := 'Stregkode';             PakkeshopText1.Caption := 'Stregkode';
1516             if (PakkeshopLevering1.Checked) then             if (PakkeshopLevering1.Checked) then
1517                MainForm.Color := HexToTColor(FarvePakkeshoplevering);                MainForm.Color := TUtils.HexToTColor(FarvePakkeshoplevering);
1518             if (Pakkernormal1.Checked) then             if (Pakkernormal1.Checked) then
1519                MainForm.Color := HexToTColor(FarveNormal);                MainForm.Color := TUtils.HexToTColor(FarveNormal);
1520             PakkeshopNulstil.Visible := false;             btnNulstil.Visible := false;
1521           end           end
1522          else          else
1523           begin           begin
# Line 1609  begin Line 1537  begin
1537    
1538      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
1539      begin      begin
1540    
1541         if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then         if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then
1542            StregKode := PakkeshopStregkode;            StregKode := PakkeshopStregkode;
1543         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 1621  begin Line 1550  begin
1550            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her            // Hvis der var sql fejl i opdateringen skal dette fejlmeldes her
1551            if Rutenummer = 'sql fejl' then            if Rutenummer = 'sql fejl' then
1552            begin   // Her skal komme en alarm og rød skærm            begin   // Her skal komme en alarm og rød skærm
1553               PlaySound(PWideChar(AlarmLyd));               VisAlarmSkaerm( 'SQL fejl: ' + Kommentar );
1554               //List1msg := 'SQL fejl: ' + Kommentar;  
              //ListBox1.Items.Insert(0,List1Msg);  
              MainForm.Color := clRed;  
              //KommentarST.Caption := List1msg;  
              PakkeshopNulstil.Visible := true;  
1555              exit;              exit;
1556            end;            end;
1557            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then            if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then
# Line 1646  begin Line 1571  begin
1571              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then              if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then
1572              begin              begin
1573                PlaySound(PWideChar(AlarmLyd));                PlaySound(PWideChar(AlarmLyd));
1574                PakkeshopNulstil.Visible := true;                btnNulstil.Visible := true;
1575                MainForm.Color := clRed;                MainForm.Color := clRed;
1576              end;              end;
1577           end;           end;
1578            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
1579            begin            begin
1580              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1581              if Storepakker1.Checked then              if Storepakker1.Checked then
1582              begin              begin
1583                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1661  begin Line 1586  begin
1586              begin              begin
1587                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1588              end;              end;
1589              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1590            end            end
1591            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then            else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
1592            begin            begin
1593              MainForm.Color := HexToTColor(Farve);              MainForm.Color := TUtils.HexToTColor(Farve);
1594              if Storepakker1.Checked then              if Storepakker1.Checked then
1595              begin              begin
1596                PlaySound(PWideChar(ScannetOkStorLyd));                PlaySound(PWideChar(ScannetOkStorLyd));
# Line 1674  begin Line 1599  begin
1599              begin              begin
1600                PlaySound(PWideChar(ScannetOkLyd));                PlaySound(PWideChar(ScannetOkLyd));
1601              end;              end;
1602              PakkeshopNulstil.Visible := false;              btnNulstil.Visible := false;
1603            end            end
1604            else if Copy(Kommentar,1,8) = 'OPRETTET' then            else if Copy(Kommentar,1,8) = 'OPRETTET' then
1605            begin            begin
# Line 1685  begin Line 1610  begin
1610            end            end
1611            else            else
1612            begin            begin
1613              MainForm.Color := clRed;              VisAlarmSkaerm('');
             PlaySound(PWideChar(AlarmLyd));  
             PakkeshopNulstil.Visible := true;  
1614            end;            end;
1615           if not PakkeshopNulstil.Visible then  
1616             if not btnNulstil.Visible then
1617            begin            begin
1618    
1619              If (Budlevering1.Checked) then              If (Budlevering1.Checked) then
# Line 1781  var Line 1705  var
1705    
1706    
1707  begin  begin
1708      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
1709      begin      begin
1710        for i := ListBox2.items.count-1 downto 0 do        for i := ListBox2.items.count-1 downto 0 do
1711          if pos(StregKode,ListBox2.items[i]) <> 0 then          if pos(StregKode,ListBox2.items[i]) <> 0 then
# Line 1792  begin Line 1716  begin
1716            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere            if (pos('/', wrkAntal) > 0) then  // både pakker idag og senere
1717            begin            begin
1718              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen              wrkAntal := wrkAntal + '/';   // tilføjer '/' sidst i feltet af hensyn til split funktionen
1719              wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));              wrkAntalIdag := StrToInt( TUtils.split(wrkAntal, '/', 2));
1720  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));  //            ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
1721  //            ShowMessage(SPLIT('data/another/','/',3));  //            ShowMessage(SPLIT('data/another/','/',3));
1722  //            ShowMessage(SPLIT('data/another','/',3));  //            ShowMessage(SPLIT('data/another','/',3));
1723              wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));              wrkAntalSenere := StrToInt( TUtils.split(wrkAntal, '/', 3));
1724            end            end
1725            else     // kun idag            else     // kun idag
1726            begin            begin
# Line 1900  begin Line 1824  begin
1824                PanelManglendePakker6.Visible := false;                PanelManglendePakker6.Visible := false;
1825              end;              end;
1826            end;            end;
1827  // 20150310: slut  
1828            ListBox2.items.delete(i);            ListBox2.items.delete(i);
1829          end;          end;
1830      end;      end;
# Line 1936  begin Line 1860  begin
1860    Sprgefterboghandlernummer1.Enabled := false;    Sprgefterboghandlernummer1.Enabled := false;
1861    ListBox1.Visible := true;    ListBox1.Visible := true;
1862  //  TestFunktionen := '1';  //  TestFunktionen := '1';
1863  // 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  
1864    if Budlevering1.Checked then    if Budlevering1.Checked then
1865    begin    begin
1866      IndlesScanningLogFil();      IndlesScanningLogFil();
# Line 1989  begin Line 1873  begin
1873      01 :      01 :
1874            begin;      // NS            begin;      // NS
1875              Testprinter1.Visible := true;              Testprinter1.Visible := true;
1876              DownloadButton01.Enabled := true;              BtnDownloadKontrolfil.Enabled := true;
1877              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1878              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1879              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1880              BladhusKontrolfil_server := 'franordjyske/RuteKontrol.txt';              BladhusKontrolfil_server := 'franordjyske/RuteKontrol.txt';
# Line 2005  begin Line 1889  begin
1889              Storepakker1.Enabled := true;              Storepakker1.Enabled := true;
1890              radioStorPakke.Enabled := true;              radioStorPakke.Enabled := true;
1891              radioLillePakke.Enabled := true;              radioLillePakke.Enabled := true;
1892              DownloadButton01.Enabled := false;     // kontrolfil bruges ikke her              BtnDownloadKontrolfil.Enabled := false;     // kontrolfil bruges ikke her
1893              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1894              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1895              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1896              IndlesManglendeScanninger();              IndlesManglendeScanninger();
# Line 2016  begin Line 1900  begin
1900              Testprinter1.Visible := true;              Testprinter1.Visible := true;
1901             if (getProddag() = 'lørdag') then             if (getProddag() = 'lørdag') then
1902              begin              begin
1903                DownloadButton03.Visible := false;                BtnDownloadRuteskiftFil.Visible := false;
1904              end              end
1905              else              else
1906              begin              begin
1907                DownloadButton03.Visible := false;                BtnDownloadRuteskiftFil.Visible := false;
1908              end;              end;
1909              DownloadButton01.Enabled := true;              BtnDownloadKontrolfil.Enabled := true;
1910              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1911              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1912              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1913              BladhusRuteskiftfil_server := 'frafd/RuteSkift.txt';              BladhusRuteskiftfil_server := 'frafd/RuteSkift.txt';
# Line 2043  begin Line 1927  begin
1927              Storepakker1.Enabled := true;              Storepakker1.Enabled := true;
1928              radioStorPakke.Enabled := true;              radioStorPakke.Enabled := true;
1929              radioLillePakke.Enabled := true;              radioLillePakke.Enabled := true;
1930              DownloadButton01.Enabled := false;    // kontrolfil bruges ikke her              BtnDownloadKontrolfil.Enabled := false;    // kontrolfil bruges ikke her
1931              OpdaterListenButton01.Enabled := true;              BtnOpdaterListen.Enabled := true;
1932              IdFTP1.Passive := true;              IdFTP1.Passive := true;
1933              IdFTP1.PassiveUseControlHost := true;              IdFTP1.PassiveUseControlHost := true;
1934            end;            end;
# Line 2060  var Line 1944  var
1944    URLStr : String;    URLStr : String;
1945    pakkestorrelse : String;    pakkestorrelse : String;
1946    PrintNyLabelInteger : Integer;    PrintNyLabelInteger : Integer;
1947    
1948      PakkeshopLabel: TPakkeshopLabel;
1949  begin  begin
1950    if radioStorPakke.Checked then    if radioStorPakke.Checked then
1951    begin    begin
# Line 2069  begin Line 1955  begin
1955    begin    begin
1956      pakkestorrelse := 'Lille';      pakkestorrelse := 'Lille';
1957    end;    end;
1958    
1959    
1960    if Pakkernormal1.Checked then    if Pakkernormal1.Checked then
1961    begin    begin
1962       if (BoghandlerTjekkode = '') then       if (BoghandlerTjekkode = '') then
# Line 2097  begin Line 1985  begin
1985    begin    begin
1986       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);       URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);
1987    end    end
1988      else if menuIndlevering.Checked then
1989      begin
1990        URLStr := Format(UrlIndleveringsPakke,[Sted, PakkeNr]);
1991      end
1992    else    else
1993    begin    begin
1994      exit;      exit;
# Line 2143  begin Line 2035  begin
2035          begin          begin
2036            PrintNyLabel := True;            PrintNyLabel := True;
2037          end;          end;
 // 20150310: start  
2038        end;        end;
 // 20150310: slut  
2039       end       end
2040        else if menuIndlevering.Checked then
2041        begin
2042    
2043    
2044    
2045    
2046         Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text;
2047         if (Kommentar = 'Ok') then
2048         begin
2049           PrintNyLabel := True; //Indleveringskode vil ALTID udskrive label
2050           PakkeshopLabel := TPakkeshopLabel.Create( XMLDocument1 ); //Opret struct og parse xml doc
2051           RuteNummer := PakkeshopLabel.Koreliste + '  ->  ' +  PakkeshopLabel.PakkeshopTurid;
2052           Stregkode := PakkeshopLabel.Stregkode;
2053    
2054           LabelPrint.PrintPakkeshopLabel( PakkeshopLabel );
2055    
2056         end;
2057    
2058    
2059        end
2060      else      else
2061       begin       begin
2062        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;        RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
# Line 2179  begin Line 2089  begin
2089          PrintNyLabel := True;          PrintNyLabel := True;
2090        end;        end;
2091      end;      end;
2092    
2093    
2094      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then      if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
2095      begin      begin
2096        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then        if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
# Line 2271  begin Line 2183  begin
2183        List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;        List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;
2184      end;      end;
2185    end;    end;
2186      if menuIndlevering.Checked then
2187      begin
2188        List1Msg := Stregkode;
2189      end;
2190    
2191    
2192    ListBox1.Items.Insert(0,List1Msg);    ListBox1.Items.Insert(0,List1Msg);
2193    logTekst := RightStr(List1Msg, Length(List1Msg)-10);    logTekst := RightStr(List1Msg, Length(List1Msg)-10);
2194    SkrivScanningLogFil(logTekst);    SkrivScanningLogFil(logTekst);
2195  end;  end;
2196    
2197  procedure TMainForm.UploadButton01Click(Sender: TObject);  procedure TMainForm.BtnUploadLogfilClick(Sender: TObject);
2198  begin  begin
2199    UploadLogfilTilDAO();    UploadLogfilTilDAO();
2200    UploadInifilTilDAO();    UploadInifilTilDAO();
# Line 2293  pakkeForkertSted : Integer; Line 2211  pakkeForkertSted : Integer;
2211    nytRuteNummer, nyFarve : String;    nytRuteNummer, nyFarve : String;
2212  begin  begin
2213    if Budlevering1.Checked then    if Budlevering1.Checked then
2214       RuteNummerST.Color := HexToTColor(Farve);       RuteNummerST.Color := TUtils.HexToTColor(Farve);
2215    
2216    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);    pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
2217    if pakkeErScannet = 0 then    if pakkeErScannet = 0 then
# Line 2338  begin Line 2256  begin
2256    
2257          PlaySound(PWideChar(AlarmLyd));          PlaySound(PWideChar(AlarmLyd));
2258          MainForm.Color := clRed;          MainForm.Color := clRed;
2259          PakkeshopNulstil.Visible := true;          btnNulstil.Visible := true;
2260    
2261       end       end
2262       else       else
# Line 2349  begin Line 2267  begin
2267            PrintNyLabel := true;            PrintNyLabel := true;
2268            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;            RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
2269            nyFarve := Farve;            nyFarve := Farve;
2270            RuteNummerST.Color := HexToTColor(nyFarve);            RuteNummerST.Color := TUtils.HexToTColor(nyFarve);
2271            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;            List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
2272            RuteNummer := nytRuteNummer;            RuteNummer := nytRuteNummer;
2273            ListBox1.Items.Insert(0,List1Msg);            ListBox1.Items.Insert(0,List1Msg);
# Line 2365  begin Line 2283  begin
2283            begin            begin
2284              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2285              MainForm.Color := clRed;              MainForm.Color := clRed;
2286              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2287            end;            end;
2288    
2289         end;         end;
# Line 2391  begin Line 2309  begin
2309            begin            begin
2310              PlaySound(PWideChar(AlarmLyd));              PlaySound(PWideChar(AlarmLyd));
2311              MainForm.Color := clRed;              MainForm.Color := clRed;
2312              PakkeshopNulstil.Visible := true;              btnNulstil.Visible := true;
2313            end;            end;
2314    
2315         end;         end;
# Line 2411  begin Line 2329  begin
2329               if PrintNyLabel or (RuteNummer = 'Rutenr') then               if PrintNyLabel or (RuteNummer = 'Rutenr') then
2330  // 20150304: slut  // 20150304: slut
2331                begin                begin
2332                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2333                end;                end;
2334              end;              end;
2335        01 :  begin;        01 :  begin;
2336               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2337                    // 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
2338                    // 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')
2339                begin                begin
2340                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2341                end;                end;
2342              end;              end;
2343        02 :  begin;        02 :  begin;
2344                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test
2345                begin                begin
2346                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2347                end;                end;
2348              end;              end;
2349        03 :  begin;        03 :  begin;
2350               if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then               if PrintNyLabel or ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
2351                    // 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
2352                    // 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')
2353               begin               begin
2354                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2355               end;               end;
2356              end;              end;
2357        04 :  begin;        04 :  begin;
2358                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test                if PrintNyLabel or (RuteNummer = 'Rutenr') then   // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test
2359                begin                begin
2360                  SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);                  LabelPrint.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
2361                end;                end;
2362              end;              end;
2363        else        else
# Line 2475  begin Line 2393  begin
2393        end;        end;
2394        logTekst := logTekst + ' for '+BoghandlerNavn;        logTekst := logTekst + ' for '+BoghandlerNavn;
2395        SkrivScanningLogFil(logTekst);        SkrivScanningLogFil(logTekst);
2396        with Printer do  
2397        begin        LabelPrint.PrintDaodirekteLabel( RuteNummer, Kommentar, BoghandlerNavn) ;
2398          BeginDoc;        
         Canvas.Font.Size := FontSizeRute;  
         if (Length(RuteNummer) > 7) then  
         begin  
           Canvas.Font.Size := FontSizeRuteLille;  
         end;  
         Canvas.TextOut(XPosRute,YPosRute, RuteNummer);  
         Canvas.Font.Size := FontSizeKommentar;  
         Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);  
         if (Kommentar = 'Ok') or (Kommentar = 'ALLEREDE SCANNET') then  
         begin  
           Kommentar := '';  
         end;  
         if (BoghandlerNavn = 'PAKKE ER SCANNET') then  
         begin  
           BoghandlerNavn := '';  
         end;  
         Canvas.TextOut(XPosKommentar,YPosKommentar, Kommentar);  // Kan ikke lave linieskift (se tidligere kommentar om samme)  
         Canvas.Font.Size := FontSizeBoghandler;  
         Canvas.TextOut(XPosBoghandler,YPosBoghandler, BoghandlerNavn);  
         EndDoc;  
       end;  
2399      end;      end;
2400    end;    end;
2401    
2402  end;  end;
2403    
 procedure TMainForm.SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');  
 begin  
     with Printer do  
     begin  
       BeginDoc;  
       Canvas.Font.Size := FontSizeRuteLille;  
       if (kontrolKoreliste <> '') then  
       begin  
         Canvas.TextOut(XPosRute,YPosRute, kontrolKoreliste);  
       end  
       else  
       begin  
         Canvas.TextOut(XPosRute,YPosRute, RuteNummer);  
       end;  
       Canvas.Font.Size := FontSizeKorelisteLille;  
       Canvas.TextOut(XPosKoreliste,YPosKoreliste, Koreliste);  
       if (Sted = 'DBK') or (Sted = '04') then  
       begin  
         Canvas.Font.Size := FontSizeSorteringsfelt1;  
         Canvas.TextOut(XPosSorteringsfelt1,YPosSorteringsfelt1, DBKbane);   // sorteringsoplysning 1  
         Canvas.Font.Size := FontSizeSorteringsfelt1;  
         Canvas.TextOut(XPosSorteringsfelt2,YPosSorteringsfelt2, Leveringssted);   // sorteringsoplysning 2  
       end;  
       Canvas.Font.Size := FontSizeKommentar;  
   
       Kommentar := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);  
       Kommentar := StringReplace(Kommentar, 'PAKKE ER SCANNET', '', [rfReplaceAll, rfIgnoreCase]);  
   
       Canvas.TextOut(XPosKommentar,YPosKommentar, Kommentar);  // Kan ikke lave linieskift (se tidligere kommentar om samme)  
       if SmsKode <> '' then  
       begin  
         Canvas.Font.Size := FontSizeSmskode;  
         Canvas.TextOut(XPosKommentar,YPosSmskode, concat('CODE: ', SmsKode));  
       end;  
       Canvas.Font.Size := FontSizeBoghandler;  
       Canvas.TextOut(XPosBoghandler,YPosBoghandler, BoghandlerNavn);  
       EndDoc;  
     end;  
 end;  
2404    
2405    
2406  procedure TMainForm.radioStorPakkeClick(Sender: TObject);  procedure TMainForm.radioStorPakkeClick(Sender: TObject);
# Line 2632  begin Line 2490  begin
2490    //UpdateScreen('', '', 'Tjekker forbindelsen...', '', '');    // virker ikke    //UpdateScreen('', '', 'Tjekker forbindelsen...', '', '');    // virker ikke
2491    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...');
2492    
2493          // Tjekker urls    try
2494          logTekst := 'Tjekker urls.';      // Tjekker urls
2495          ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);      logTekst := 'Tjekker urls.';
2496          SkrivScanningLogFil(logTekst);      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2497        SkrivScanningLogFil(logTekst);
2498    
         // 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;  
2499    
         // 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;  
2500    
2501          // Tjekker UrlReturBoghandler      // Tjekker UrlNormal
2502          if PanelValg3.Enabled = true then      if PanelValg1.Enabled = true then
2503          begin      begin
2504            if CheckUrl(UrlReturBoghandler) then        TjekkerEnkeltUrl('UrlNormal', UrlNormal, urlFejl);
2505            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;  
2506    
2507          // Tjekker UrlBudlevering      // Tjekker UrlReturDAO
2508          if PanelValg4.Enabled = true then      if PanelValg2.Enabled = true then
2509          begin      begin
2510            if CheckUrl(UrlBudlevering) then        TjekkerEnkeltUrl('UrlReturDAO', UrlReturDAO, urlFejl);
2511            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;  
2512    
2513          // Tjekker UrlPakkeshoplevering      // Tjekker UrlReturBoghandler
2514          if PanelValg5.Enabled = true then      if PanelValg3.Enabled = true then
2515          begin      begin
2516            if CheckUrl(UrlPakkeshoplevering) then        TjekkerEnkeltUrl('UrlReturBoghandler', UrlReturBoghandler, urlFejl);
2517            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;  
2518    
2519          // Tjekker UrlReturPakkeshop      // Tjekker UrlBudlevering
2520          if PanelValg6.Enabled = true then      if PanelValg4.Enabled = true then
2521          begin      begin
2522            if CheckUrl(UrlReturPakkeshop) then        TjekkerEnkeltUrl('UrlBudlevering', UrlBudlevering, urlFejl);
2523            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;  
2524    
2525          // Tjekker UrlManglendeScanninger      // Tjekker UrlPakkeshoplevering
2526          if (PanelValg1.Enabled = true)      if PanelValg5.Enabled = true then
2527          or (PanelValg4.Enabled = true) then      begin
2528          begin        TjekkerEnkeltUrl('UrlPakkeshoplevering', UrlPakkeshoplevering, urlFejl);
2529            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;  
2530    
2531          // Tjekker UrlPakkeshopManglendeScanninger      // Tjekker UrlReturPakkeshop
2532          if PanelValg5.Enabled = true then      if PanelValg6.Enabled = true then
2533          begin      begin
2534            if CheckUrl(UrlPakkeshopManglendeScanninger) then        TjekkerEnkeltUrl('UrlReturPakkeshop', UrlReturPakkeshop, urlFejl);
2535            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;  
2536    
2537          // Tjekker UrlPakkeshopManglendeReturScanninger      // Tjekker UrlManglendeScanninger
2538          if PanelValg6.Enabled = true then      if (PanelValg1.Enabled = true) or (PanelValg4.Enabled = true) then
2539          begin      begin
2540            if CheckUrl(UrlPakkeshopManglendeReturScanninger) then        TjekkerEnkeltUrl('UrlManglendeScanninger', UrlManglendeScanninger, urlFejl);
2541            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;  
2542    
2543          // Tjekker UrlEKLoverforsel      // Tjekker UrlPakkeshopManglendeScanninger
2544          if PanelValg1.Enabled = true then      if PanelValg5.Enabled = true then
2545          begin      begin
2546            if CheckUrl(UrlEKLoverforsel) then        TjekkerEnkeltUrl('UrlPakkeshopManglendeScanninger', UrlPakkeshopManglendeScanninger, urlFejl);
2547            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;  
2548    
2549        // Tjekker UrlPakkeshopManglendeReturScanninger
2550        if PanelValg6.Enabled = true then
2551        begin
2552          TjekkerEnkeltUrl('UrlPakkeshopManglendeReturScanninger', UrlPakkeshopManglendeReturScanninger, urlFejl);
2553        end;
2554    
2555          // Tjekker UrlEKLoverforselPakkeshop     // Tjekker UrlIndleveringsPakke og UrlIndleveringsPakkeManglendeScanninger
2556          if PanelValg5.Enabled = true then      if PanelValg7.Enabled = true then
2557          begin      begin
2558            if CheckUrl(UrlEKLoverforselPakkeshop) then        TjekkerEnkeltUrl('UrlIndleveringsPakke', UrlIndleveringsPakke, urlFejl);
2559            begin        TjekkerEnkeltUrl('UrlIndleveringsPakkeManglendeScanninger', UrlIndleveringsPakkeManglendeScanninger, urlFejl);
2560              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;  
2561    
2562        // Tjekker UrlEKLoverforsel
2563        if PanelValg1.Enabled = true then
2564        begin
2565          TjekkerEnkeltUrl('UrlEKLoverforsel', UrlEKLoverforsel, urlFejl);
2566        end;
2567    
         // 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;  
2568    
2569          // Tjekker UrlSendPrograminfo      // Tjekker UrlEKLoverforselPakkeshop
2570          if CheckUrl(UrlSendPrograminfo) then      if PanelValg5.Enabled = true then
2571          begin      begin
2572            logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;        TjekkerEnkeltUrl('UrlEKLoverforselPakkeshop', UrlEKLoverforselPakkeshop, urlFejl);
2573            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;  
2574    
         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;  
2575    
2576        // Tjekker UrlFindPakketype
2577        TjekkerEnkeltUrl('UrlFindPakketype', UrlFindPakketype, urlFejl);
2578    
2579        // Tjekker UrlSendPrograminfo
2580        TjekkerEnkeltUrl('UrlSendPrograminfo', UrlSendPrograminfo, urlFejl);
2581    
2582    
2583    
2584        logTekst := 'urls er ok';
2585        ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2586        SkrivScanningLogFil(logTekst);
2587    
2588      Except
2589        TjekUrls := '-';   // markerer at der var fejl
2590    
2591      end;
2592  end;  end;
2593    
2594  function TMainForm.FileTime2DateTime(FileTime: TFileTime): TDateTime;  procedure TMainForm.TjekkerEnkeltUrl(UrlNavn: String; Url: String; var urlFejl: integer);
2595  var  const
2596     LocalFileTime: TFileTime;    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
    SystemTime: TSystemTime;  
2597  begin  begin
2598     FileTimeToLocalFileTime(FileTime, LocalFileTime) ;    if TUtils.CheckUrl(Url) then
2599     FileTimeToSystemTime(LocalFileTime, SystemTime) ;  
2600     Result := SystemTimeToDateTime(SystemTime) ;    begin
2601        logTekst := UrlNavn + ' accepteret: ' + Url;
2602        SkrivScanningLogFil(logTekst);
2603      end
2604      else
2605      begin
2606        inc(urlFejl);   // Optæller antal fejl
2607        logTekst := UrlNavn + ' svarer ikke: ' + Url;
2608        ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
2609        if TjekUrls = '1' then
2610        begin
2611          logTekst := logTekst + crlf + crlf + 'Programmet afsluttes... ';
2612        end;
2613    
2614        SkrivScanningLogFil(logTekst);
2615    
2616        if TjekUrls = '1' then
2617        begin
2618          ShowMessage(logTekst);
2619          UrlSendPrograminfo := '';   // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut
2620          Application.Terminate;
2621    
2622          raise Exception.Create('UrlFejl');
2623    
2624        end;
2625      end;
2626    
2627  end;  end;
2628    
2629    
2630    
2631  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);  procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);
2632  var  var
2633    SR: TSearchRec;    SR: TSearchRec;
# Line 3038  begin Line 2644  begin
2644      repeat      repeat
2645        if (SR.Attr <> faDirectory) then        if (SR.Attr <> faDirectory) then
2646        begin        begin
2647    
2648          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring          dt := fileDateToDateTime(SR.Time);  // finder filens timestamp for seneste ændring
2649          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse          CreationTime := SR.FindData.ftCreationTime;  // finder filens timestamp for oprettelse
2650          dtCreation := FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse          dtCreation := TUtils.FileTime2DateTime(CreationTime);   // finder filens timestamp for oprettelse
2651          // Selvom creation date godt kan være forskellig fra modified date,          // Selvom creation date godt kan være forskellig fra modified date,
2652          // skal vi alligevel altid tjekke filens alder ud fra modified date          // skal vi alligevel altid tjekke filens alder ud fra modified date
2653          // (æ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 3077  begin Line 2684  begin
2684    end;    end;
2685  end;  end;
2686    
2687  procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);  procedure TMainForm.btnNulstilClick(Sender: TObject);
2688  begin  begin
2689    PakkeshopStregkode := '';    PakkeshopStregkode := '';
2690    PakkeshopTjekkode := '';    PakkeshopTjekkode := '';
2691    PakkeshopNulstil.Visible := false;    btnNulstil.Visible := false;
2692    PakkeshopText1.Caption := 'Stregkode';    PakkeshopText1.Caption := 'Stregkode';
2693    BoghandlerStregkode := '';    BoghandlerStregkode := '';
2694    BoghandlerTjekkode := '';    BoghandlerTjekkode := '';
# Line 3099  begin Line 2706  begin
2706  //  MainForm.Color := HexToTColor(Farve);  //  MainForm.Color := HexToTColor(Farve);
2707    if Farve <> '' then    if Farve <> '' then
2708    begin    begin
2709       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  
2710    end;    end;
2711    if (Budlevering1.Checked) then    if (Budlevering1.Checked) then
2712    begin    begin
# Line 3173  end; Line 2770  end;
2770    
2771  procedure TMainForm.PanelValgAClick(Sender: TObject);  procedure TMainForm.PanelValgAClick(Sender: TObject);
2772  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;  
 *)  
2773  // Skal ikke toggle men bare sætte funktionen on  // Skal ikke toggle men bare sætte funktionen on
2774  // Fravælges ved at vælge en scanningstype  // Fravælges ved at vælge en scanningstype
2775       AutomatiskValg1.Checked := true;    AutomatiskValg1.Checked := true;
2776       PanelValgA.Color := clGreen;    PanelValgA.Color := clGreen;
2777       PanelValgA.Font.Color := clWhite;    PanelValgA.Font.Color := clWhite;
2778  // 20150311: slut  
2779    
2780    
2781  end;  end;
2782    
2783  procedure TMainForm.Pakkernormal1Click(Sender: TObject);  procedure TMainForm.Pakkernormal1Click(Sender: TObject);
# Line 3231  begin Line 2815  begin
2815      // Her kommer en alarm og rød skærm      // Her kommer en alarm og rød skærm
2816      PlaySound(PWideChar(AlarmLyd));      PlaySound(PWideChar(AlarmLyd));
2817      MainForm.Color := clRed;      MainForm.Color := clRed;
2818      PakkeshopNulstil.Visible := true;      btnNulstil.Visible := true;
2819    end    end
2820    else    else
2821    begin    begin
# Line 3266  begin Line 2850  begin
2850    Falsk := False;    Falsk := False;
2851    
2852    
2853    if (Printer.Printers.Count = 0) then    if (LabelPrint.GetPrinterCount() = 0) then
2854    begin    begin
2855      ShowMessage('Der er ikke installeret en printer på denne PC.');      ShowMessage('Der er ikke installeret en printer på denne PC.');
2856    end    end
# Line 3281  begin Line 2865  begin
2865      DBKbane := '999';      DBKbane := '999';
2866      Leveringssted := 'XXX';      Leveringssted := 'XXX';
2867      PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);      PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);
2868      CheckPrintQue('Test');      LabelPrint.CheckPrintQue('Test', PrinterNavn);
2869    end;    end;
2870    FocusControl(StregkodeST);    FocusControl(StregkodeST);
2871  end;  end;
# Line 3290  procedure TMainForm.Timer1Timer(Sender: Line 2874  procedure TMainForm.Timer1Timer(Sender:
2874  begin  begin
2875    if (TjekPrinter = '1') then    if (TjekPrinter = '1') then
2876    begin    begin
2877      CheckPrintQue('Timer');      LabelPrint.CheckPrintQue('Timer', PrinterNavn);
2878    end    end
2879    else    else
2880    begin    begin
# Line 3299  begin Line 2883  begin
2883    end;    end;
2884  end;  end;
2885    
2886  {  
  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;  
2887    
2888  procedure TMainForm.Om1Click(Sender: TObject);  procedure TMainForm.Om1Click(Sender: TObject);
2889  const  const
# Line 3337  var Line 2892  var
2892   tekst, filversion : String;   tekst, filversion : String;
2893  begin  begin
2894    
2895    filversion := Sto_GetFmtFileVersion('','');    filversion := TUtils.Sto_GetFmtFileVersion('');
2896    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';
2897    
2898    tekst := tekst+crlf+crlf;    tekst := tekst+crlf+crlf;
# Line 3359  begin Line 2914  begin
2914          end          end
2915          else          else
2916          begin          begin
2917            tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';            tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+Sted+')';
2918          end;          end;
2919      end      end
2920      else      else
2921      begin      begin
2922        tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';        tekst := tekst+crlf+crlf+'Speciel version til: ' + TUtils.split(Titel, ':', 2) + ' ('+SpecialVersionSted+')';
2923      end;      end;
2924    end;    end;
2925    
# Line 3432  begin Line 2987  begin
2987    
2988    if FileExists(fileName) then    if FileExists(fileName) then
2989    begin    begin
2990      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
2991      begin      begin
2992        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
2993        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
# Line 3456  begin Line 3011  begin
3011    
3012    if FileExists(fileName) then    if FileExists(fileName) then
3013    begin    begin
3014      if AdobeReaderExists then      if TUtils.AdobeReaderExists then
3015      begin      begin
3016        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);        //ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
3017        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);        ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
3018      end      end
3019      else      else
3020      begin      begin
3021        ShowMessage('Acrobat Reader er ikke installeret!');        ShowMessage('Adobe Reader er ikke installeret!');
3022      end;      end;
3023    end    end
3024    else    else
# Line 3472  begin Line 3027  begin
3027    end;    end;
3028  end;  end;
3029    
3030    procedure TMainForm.menuIndleveringClick(Sender: TObject);
3031    begin
3032      Scanningtype := '7';
3033      NulstilAutomatiskValg();
3034      InitIndleveringskode();
3035    end;
3036    
3037  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);  procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
3038  begin  begin
3039    
# Line 3504  end; Line 3066  end;
3066  procedure TMainForm.InitNatxpresslevering();  procedure TMainForm.InitNatxpresslevering();
3067  begin  begin
3068        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3069        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3070        Pakkernormal1.Checked := true;        Pakkernormal1.Checked := true;
3071        InitForm(FarveNormal,TitelNormal,UrlNormal);        InitForm(FarveNormal,TitelNormal,UrlNormal);
3072        PanelValg1.Color := clGreen;        PanelValg1.Color := clGreen;
# Line 3522  begin Line 3084  begin
3084        radioStorPakke.Enabled := false;        radioStorPakke.Enabled := false;
3085        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3086        ListBox1.Visible := true;        ListBox1.Visible := true;
3087        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3088        EKLoverforsel.Enabled := true;        BtnEKLoverforsel.Enabled := true;
3089        InitLillePakke();        InitLillePakke();
3090        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3091    
3092          chkForstorTilDirekte.Checked := false;
3093          chkForstorTilDirekte.Enabled := false;
3094    
3095        if BladhusSted = 0 then        if BladhusSted = 0 then
3096        begin        begin
3097          IndlesScanningLogFil();          IndlesScanningLogFil();
# Line 3537  procedure TMainForm.InitReturFraDao(); Line 3103  procedure TMainForm.InitReturFraDao();
3103  begin  begin
3104        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3105        ReturpakkerfraDAO1.Checked := true;        ReturpakkerfraDAO1.Checked := true;
3106        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3107        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);        InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
3108        PanelValg2.Color := clGreen;        PanelValg2.Color := clGreen;
3109        PanelValg2.Font.Color := clWhite;        PanelValg2.Font.Color := clWhite;
# Line 3556  begin Line 3122  begin
3122        ListBox1.Visible := true;        ListBox1.Visible := true;
3123        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3124        ListBox2.Items.Clear;        ListBox2.Items.Clear;
3125        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3126    
3127          chkForstorTilDirekte.Checked := false;
3128          chkForstorTilDirekte.Enabled := false;
3129    
3130        InitLillePakke();        InitLillePakke();
3131  end;  end;
3132    
# Line 3564  procedure TMainForm.InitReturFraKunde(); Line 3134  procedure TMainForm.InitReturFraKunde();
3134  begin  begin
3135        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3136        Returpakkerfraboghandler1.Checked := true;        Returpakkerfraboghandler1.Checked := true;
3137        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3138        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);        InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
3139        PanelValg3.Color := clGreen;        PanelValg3.Color := clGreen;
3140        PanelValg3.Font.Color := clWhite;        PanelValg3.Font.Color := clWhite;
# Line 3582  begin Line 3152  begin
3152        ListBox1.Visible := true;        ListBox1.Visible := true;
3153        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3154        ListBox2.Items.Clear;        ListBox2.Items.Clear;
3155        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3156    
3157          chkForstorTilDirekte.Checked := false;
3158          chkForstorTilDirekte.Enabled := false;
3159    
3160        InitLillePakke();        InitLillePakke();
3161  end;  end;
3162    
# Line 3590  procedure TMainForm.InitDirektelevering( Line 3164  procedure TMainForm.InitDirektelevering(
3164  begin  begin
3165        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3166        Budlevering1.Checked := true;        Budlevering1.Checked := true;
3167        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3168        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);        InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
3169        PanelValg4.Color := clGreen;        PanelValg4.Color := clGreen;
3170        PanelValg4.Font.Color := clWhite;        PanelValg4.Font.Color := clWhite;
# Line 3608  begin Line 3182  begin
3182        radioLillePakke.Enabled := true;        radioLillePakke.Enabled := true;
3183        ListBox1.Visible := true;        ListBox1.Visible := true;
3184        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3185        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3186        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3187        DownloadButton03.Visible := false;        BtnDownloadRuteskiftFil.Visible := false;
3188        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3189        IdFTP1.Passive := true;        IdFTP1.Passive := true;
3190        IdFTP1.PassiveUseControlHost := true;        IdFTP1.PassiveUseControlHost := true;
3191    
3192          chkForstorTilDirekte.Checked := false;
3193          chkForstorTilDirekte.Enabled := true;
3194    
3195        if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then        if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then
3196        begin        begin
3197            IndlesScanningLogFil();            IndlesScanningLogFil();
# Line 3626  procedure TMainForm.InitPakkeshopleverin Line 3204  procedure TMainForm.InitPakkeshopleverin
3204  begin  begin
3205        AutomatiskTjekkodeStyring1.Enabled := true;        AutomatiskTjekkodeStyring1.Enabled := true;
3206        Pakkeshoplevering1.Checked := true;        Pakkeshoplevering1.Checked := true;
3207        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3208        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);        InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
3209        PanelValg5.Color := clGreen;        PanelValg5.Color := clGreen;
3210        PanelValg5.Font.Color := clWhite;        PanelValg5.Font.Color := clWhite;
# Line 3644  begin Line 3222  begin
3222        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3223        ListBox1.Visible := true;        ListBox1.Visible := true;
3224        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3225        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3226        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3227    
3228          BtnEKLoverforsel.Enabled := true;
3229    
3230        EKLoverforsel.Enabled := true;        chkForstorTilDirekte.Checked := false;
3231          chkForstorTilDirekte.Enabled := true;
3232    
3233        InitLillePakke();        InitLillePakke();
3234        IndlesScanningLogFil();        IndlesScanningLogFil();
# Line 3663  procedure TMainForm.InitReturFraPakkesho Line 3244  procedure TMainForm.InitReturFraPakkesho
3244  begin  begin
3245        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3246        Returpakkerfrapakkeshop1.Checked := true;        Returpakkerfrapakkeshop1.Checked := true;
3247        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3248        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);        InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
3249        PanelValg6.Color := clGreen;        PanelValg6.Color := clGreen;
3250        PanelValg6.Font.Color := clWhite;        PanelValg6.Font.Color := clWhite;
# Line 3681  begin Line 3262  begin
3262        radioLillePakke.Enabled := false;        radioLillePakke.Enabled := false;
3263        ListBox1.Visible := true;        ListBox1.Visible := true;
3264        ListBox1.Items.Clear;        ListBox1.Items.Clear;
3265        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3266        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3267        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3268    
3269          chkForstorTilDirekte.Checked := false;
3270          chkForstorTilDirekte.Enabled := false;
3271    
3272    
3273        InitLillePakke();        InitLillePakke();
3274        IndlesScanningLogFil();        IndlesScanningLogFil();
3275        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3703  end; Line 3289  end;
3289    
3290  procedure TMainForm.InitIndleveringskode();  procedure TMainForm.InitIndleveringskode();
3291  begin  begin
3292          menuIndlevering.Checked := true;
3293        AutomatiskTjekkodeStyring1.Enabled := false;        AutomatiskTjekkodeStyring1.Enabled := false;
3294        Returpakkerfrapakkeshop1.Checked := true;  
3295        PakkeshopNulstil.Visible := false;        btnNulstil.Visible := false;
3296        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);        InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
3297        PanelValg7.Color := clGreen;        PanelValg7.Color := clGreen;
3298        PanelValg7.Font.Color := clWhite;        PanelValg7.Font.Color := clWhite;
# Line 3727  begin Line 3314  begin
3314        ListBox1.Visible := true;        ListBox1.Visible := true;
3315        ListBox1.Items.Clear();        ListBox1.Items.Clear();
3316    
3317        DownloadButton01.Enabled := false;        BtnDownloadKontrolfil.Enabled := false;
3318        OpdaterListenButton01.Enabled := true;        BtnOpdaterListen.Enabled := true;
3319        EKLoverforsel.Enabled := false;        BtnEKLoverforsel.Enabled := false;
3320    
3321          chkForstorTilDirekte.Checked := false;
3322          chkForstorTilDirekte.Enabled := false;
3323    
3324    
3325        InitLillePakke();        InitLillePakke();
3326        IndlesScanningLogFil();        IndlesScanningLogFil();
3327        if BladhusSted = 0 then        if BladhusSted = 0 then
# Line 3767  begin Line 3359  begin
3359  // 20150310: slut  // 20150310: slut
3360  end;  end;
3361    
 /// <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]]);  
3362    
     // 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;  
3363    
3364  procedure TMainForm.PlaySound(filename : PWideChar);  procedure TMainForm.PlaySound(filename : PWideChar);
3365  begin  begin
# Line 3903  begin; Line 3430  begin;
3430    CheckCode();    CheckCode();
3431  end;  end;
3432    
3433  procedure TMainForm.EKLoverforselClick(Sender: TObject);  procedure TMainForm.BtnEKLoverforselClick(Sender: TObject);
3434  var  var
3435    WebSvar : String;    WebSvar : String;
3436    URLStr : String;    URLStr : String;
# Line 3913  var Line 3440  var
3440    status, kommentar : String;    status, kommentar : String;
3441    
3442  begin  begin
3443      EKLoverforsel.Enabled := false;      BtnEKLoverforsel.Enabled := false;
3444    
3445      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');
3446      logTekst := 'Overfører de scannede pakker til EKL';      logTekst := 'Overfører de scannede pakker til EKL';
3447      SkrivScanningLogFil(logTekst);      SkrivScanningLogFil(logTekst);
3448      StedKode := Sted;      StedKode := Sted;
3449      URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);      URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);
3450  // 20150330: start  
3451      if PanelValg5.Color = clGreen then      if PanelValg5.Color = clGreen then
3452      begin      begin
3453        URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);        URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);
3454      end;      end;
3455  // 20150330: slut  
3456    
3457      try      try
3458      //raise EIdConnClosedGracefully.Create('test');   // KUN TIL TEST      //raise EIdConnClosedGracefully.Create('test');   // KUN TIL TEST
# Line 3976  begin Line 3503  begin
3503        end;        end;
3504      end;      end;
3505    
3506      EKLoverforsel.Enabled := true;      BtnEKLoverforsel.Enabled := true;
3507    
3508      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
3509    
# Line 3993  begin Line 3520  begin
3520           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';           BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
3521         end;         end;
3522         KommentarST.Caption := Kommentar;         KommentarST.Caption := Kommentar;
3523         PakkeshopNulstil.Visible := true;         btnNulstil.Visible := true;
3524      end;      end;
3525    
3526  end;  end;
# Line 4017  begin Line 3544  begin
3544    else    else
3545      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);      MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
3546  }  }
3547    Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;    Svar := 'Beregnet: ' + TUtils.CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
3548    
3549    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);    MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
3550    CheckCode();    CheckCode();
# Line 4025  end; Line 3552  end;
3552    
3553  end;  end;
3554    
 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;  
3555    
3556  //  //
3557  // Bladhus ***  // Bladhus ***
# Line 4541  begin Line 4029  begin
4029    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
4030  end;  end;
4031    
4032  procedure TMainForm.DownloadButton01Click(Sender: TObject);  procedure TMainForm.BtnDownloadKontrolfilClick(Sender: TObject);
4033  begin  begin
4034      DownloadBladhusKontrolfil();      DownloadBladhusKontrolfil();
4035      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
4036  end;  end;
4037    
4038  procedure TMainForm.OpdaterListenButton01Click(Sender: TObject);  procedure TMainForm.BtnOpdaterListenClick(Sender: TObject);
4039  const  const
4040    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed    crlf = Chr(13) + Chr(10) ;  // Carriage return & Linefeed
4041    
# Line 4556  begin Line 4044  begin
4044      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
4045  end;  end;
4046    
4047  procedure TMainForm.DownloadButton03Click(Sender: TObject);  procedure TMainForm.BtnDownloadRuteskiftFilClick(Sender: TObject);
4048  begin  begin
4049      if (getProddag() = 'lørdag') then      if (getProddag() = 'lørdag') then
4050      begin      begin
# Line 4565  begin Line 4053  begin
4053      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
4054  end;  end;
4055    
4056  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;  
4057    
4058  procedure TMainForm.IndlesManglendeScanninger();  procedure TMainForm.IndlesManglendeScanninger();
4059  var  var
# Line 4589  var Line 4065  var
4065    stregkode, modtagernavn, modtageradresse, kommentar : string;    stregkode, modtagernavn, modtageradresse, kommentar : string;
4066    pakketype, tjekkodestatus : String;    pakketype, tjekkodestatus : String;
4067    pakketypeix, antalLiniefelter, antalFelterFundet, linienr : Integer;    pakketypeix, antalLiniefelter, antalFelterFundet, linienr : Integer;
4068    pakketyper : TStrings;    //pakketyper : TStrings;
4069      pakketyper : TDictionary<String, Integer>;
4070      tmpAntal : Integer;
4071    
4072    
4073    
4074    antlin : Integer;    antlin : Integer;
4075    
4076    antlinIdag, antlinSenere : Integer;    antlinIdag, antlinSenere : Integer;
4077    
4078    XmlFelter : TStrings;    //XmlFelter : TStrings;
4079      XmlFelter : TDictionary<String, Integer>;
4080    
4081   begin   begin
4082      XmlFelter := TStringList.Create;  
4083      pakketyper := TStringList.Create;  
4084        XmlFelter := TDictionary<String, Integer>.Create;
4085        pakketyper := TDictionary<String, Integer>.Create;
4086    
4087      linienr := 0;      linienr := 0;
4088      ListBox2.Clear;      ListBox2.Clear;
4089      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Henter oversigt over pakker der endnu ikke er modtaget');      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Henter oversigt over pakker der endnu ikke er modtaget');
# Line 4613  var Line 4098  var
4098          StedKode := Sted;          StedKode := Sted;
4099        end;        end;
4100    
4101          Application.Processmessages; //Ugly Hack to improve User Experience when switching modes
4102    
4103    
4104      if (Scanningtype = '6') then  
4105        if (Scanningtype = '7') then
4106         begin
4107          URLStr := Format(UrlIndleveringsPakkeManglendeScanninger, [StedKode]);
4108         end
4109        else if (Scanningtype = '6') then
4110       begin       begin
4111        URLStr := Format(UrlPakkeshopManglendeReturScanninger,[StedKode]);        URLStr := Format(UrlPakkeshopManglendeReturScanninger, [StedKode]);
4112       end       end
4113      else if (Scanningtype = '5') then      else if (Scanningtype = '5') then
4114       begin       begin
4115        URLStr := Format(UrlPakkeshopManglendeScanninger,[StedKode]);        URLStr := Format(UrlPakkeshopManglendeScanninger, [StedKode]);
4116       end       end
4117      else if (Scanningtype = '1') then      else if (Scanningtype = '1') then
4118       begin       begin
# Line 4667  var Line 4159  var
4159            if Node.NodeType = ntElement then begin            if Node.NodeType = ntElement then begin
4160              if Node.NodeName = 'Stregkode' then              if Node.NodeName = 'Stregkode' then
4161              begin              begin
4162                 antlin := antlin + 1;                 Inc(antlin);
4163                 // 20150306: start                 // 20150306: start
4164                if not VarIsNull(Node.NodeValue) then                if not VarIsNull(Node.NodeValue) then
4165                begin                begin
4166                   if (pos('(', Node.NodeValue) = 0) then                   if (pos('(', Node.NodeValue) = 0) then
4167                   begin                   begin
4168                     antlinIdag := antlinIdag + 1;                     Inc(antlinIdag);
4169                   end                   end
4170                   else                   else
4171                   begin                   begin
4172                     antlinSenere := antlinSenere + 1;                     Inc(antlinSenere);
4173                   end;                   end;
4174                end;                end;
4175                 // 20150306: slut                 // 20150306: slut
4176              end;              end;
4177            end;            end;
4178            if (XmlFelter.values[Node.NodeName] <> '') then            if ( XmlFelter.ContainsKey(Node.NodeName) ) then
4179                  XmlFelter.values[Node.NodeName] := IntToStr(StrToInt(XmlFelter.values[Node.NodeName]) + 1)                begin
4180                    XmlFelter.TryGetValue(Node.NodeName, tmpAntal);
4181                    XmlFelter.AddOrSetValue(Node.NodeName, tmpAntal + 1);
4182                  end
4183                else                else
4184                  XmlFelter.values[Node.NodeName] := '1';                begin
4185                    XmlFelter.Add(Node.NodeName, 1);
4186                  end;
4187    
4188        end;        end;
4189        antalLiniefelter := XmlFelter.Count;        antalLiniefelter := XmlFelter.Count;
# Line 4694  var Line 4191  var
4191        SetLength(stregkoderMedTjekkodeArray, 0);    // reset fra tidligere brug        SetLength(stregkoderMedTjekkodeArray, 0);    // reset fra tidligere brug
4192        SetLength(stregkoderMedTjekkodeArray, antlin);  // sæt antal elementer i array        SetLength(stregkoderMedTjekkodeArray, antlin);  // sæt antal elementer i array
4193    
4194    
4195          Application.Processmessages; //Ugly Hack to improve User Experience when switching modes
4196    
4197        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';
4198        if (antlinSenere > 0) then        if (antlinSenere > 0) then
4199        begin        begin
# Line 4729  var Line 4229  var
4229                if not VarIsNull(Node.NodeValue) then                if not VarIsNull(Node.NodeValue) then
4230                  pakketype := Node.NodeValue;                  pakketype := Node.NodeValue;
4231                  antalFelterFundet := antalFelterFundet + 1;                  antalFelterFundet := antalFelterFundet + 1;
4232                if (pakketyper.values[pakketype] <> '') then                if ( pakketyper.ContainsKey(pakketype) ) then
4233                  pakketyper.values[pakketype] := IntToStr(StrToInt(pakketyper.values[pakketype]) + 1)                begin
4234                    pakketyper.TryGetValue(pakketype, tmpAntal);
4235                    pakketyper.AddOrSetValue(pakketype, tmpAntal + 1);
4236                  end
4237                else                else
4238                  pakketyper.values[pakketype] := '1';                  pakketyper.Add(pakketype, 1);
4239              end;              end;
4240              if Node.NodeName = 'TjekkodeStatus' then begin              if Node.NodeName = 'TjekkodeStatus' then begin
4241                if not VarIsNull(Node.NodeValue) then                if not VarIsNull(Node.NodeValue) then
# Line 4740  var Line 4243  var
4243                  antalFelterFundet := antalFelterFundet + 1;                  antalFelterFundet := antalFelterFundet + 1;
4244                  if (tjekkodestatus = '-1') then                  if (tjekkodestatus = '-1') then
4245                  begin                  begin
4246  // 20150306: start  
 //                    stregkoderMedTjekkodeArray[linienr] := stregkode;  
4247                    if (pos(' ', stregkode) > 0) then                    if (pos(' ', stregkode) > 0) then
4248                    begin                    begin
4249                      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
4250                    end                    end
4251                    else                    else
4252                    begin                    begin
# Line 4768  var Line 4270  var
4270              end;              end;
4271            end;            end;
4272        end;        end;
       for pakketypeix := 0 to pakketyper.Count-1 do  
         begin  
           ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + ' '+pakketyper[pakketypeix]+' pakke(r) ikke modtaget');  
         end;  
4273    
4274          // Free up the list object        Application.Processmessages; //Ugly Hack to improve User Experience when switching modes
4275    
4276    
4277          for pakketype in pakketyper.Keys do
4278          begin
4279            pakketyper.TryGetValue(pakketype, tmpAntal);
4280            ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + pakketype + ' ' + IntToStr(tmpAntal) + ' pakke(r) ikke modtaget');
4281          end;
4282    
4283            // Free up the dictionary object
4284        pakketyper.Free;        pakketyper.Free;
4285    
4286    
4287    
4288  //      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Der er '+IntToStr(antlin)+' pakker, der endnu ikke er modtaget.');  //      ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Der er '+IntToStr(antlin)+' pakker, der endnu ikke er modtaget.');
4289        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';        logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';
4290        if (antlinSenere > 0) then        if (antlinSenere > 0) then
# Line 4934  var Line 4444  var
4444     idag, imorgen : TDateTime;     idag, imorgen : TDateTime;
4445     imorgenYmd : string;     imorgenYmd : string;
4446     logFilnavn : string;     logFilnavn : string;
4447      error : Integer;     //error : Integer;
4448    
4449  begin  begin
4450    if (SkrivLog = '1') then    if (SkrivLog = '1') then
# Line 5026  begin Line 4536  begin
4536          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
4537          S := buffer;          S := buffer;
4538          SetLength(A,0);          SetLength(A,0);
4539          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
4540          if (length(A) < 2) then          if (length(A) < 2) then
4541          begin          begin
4542            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
4543          end;          end;
4544            if (length(A) > 1) then            if (length(A) > 1) then
4545            begin            begin
# Line 5103  begin Line 4613  begin
4613          ReadLn(SomeTxtFile, buffer) ;          ReadLn(SomeTxtFile, buffer) ;
4614          S := buffer;          S := buffer;
4615          SetLength(A,0);          SetLength(A,0);
4616          Explode(A, ';', S);          TUtils.Explode(A, ';', S);
4617          if (length(A) < 3) then          if (length(A) < 3) then
4618          begin          begin
4619            Explode(A, ',', S);            TUtils.Explode(A, ',', S);
4620          end;          end;
4621          if (A[0]=imorgenYmd) then          if (A[0]=imorgenYmd) then
4622          begin          begin
# Line 5203  begin Line 4713  begin
4713    //ShowMessage('Ændring ikke tilladt');    //ShowMessage('Ændring ikke tilladt');
4714    // Her skal komme en 'rød skærm' alarm    // Her skal komme en 'rød skærm' alarm
4715    PlaySound(PWideChar(AlarmLyd));    PlaySound(PWideChar(AlarmLyd));
   
   ListBox1.Items.Insert(0, strMessage);  
4716    MainForm.Color := clRed;    MainForm.Color := clRed;
4717    
4718    
4719    RuteNummerST.Caption := '';    RuteNummerST.Caption := '';
4720    BoghandlerNavnST.Caption := '';    BoghandlerNavnST.Caption := '';
4721    KommentarST.Caption := strMessage;    btnNulstil.Visible := true;
4722    PakkeshopNulstil.Visible := true;  
4723      if (strMessage <> '') then
4724      begin
4725        ListBox1.Items.Insert(0, strMessage);
4726        KommentarST.Caption := strMessage;
4727      end;
4728    
4729  end;  end;
4730    
4731  function TMainForm.getProddato() : TDate;  function TMainForm.getProddato() : TDate;
# Line 5269  begin Line 4785  begin
4785    result := svar;    result := svar;
4786  end;  end;
4787    
 function TMainForm.GetCurrentPrinterHandle: THandle;  
 var  
   Device, Driver, Port: array[0..255] of Char;  
   hDeviceMode: THandle;  
 begin  
   Printer.GetPrinter(Device, Driver, Port, hDeviceMode);  
   if not OpenPrinter(@Device, Result, nil) then  
     RaiseLastWin32Error;  
 end;  
   
 function TMainForm.SavePChar(p: PChar): PChar;  
 const  
   error: PChar = 'Nil';  
 begin  
   if not Assigned(p) then  
     Result := error  
   else  
     Result := p;  
 end;  
4788    
4789  procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);  procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);
4790  begin  begin
# Line 5301  begin Line 4798  begin
4798    end;    end;
4799  end;  end;
4800    
4801  function TMainForm.AdobeReaderExists: Boolean;  
4802  var  
4803    AReg: TRegistry;  //Nedarvet fra IParentForm
4804    procedure TMainForm.LogMessage( msg : string);
4805  begin  begin
4806    result:= false;    ListBox1.Items.Insert(0, msg);
4807    AReg := TRegistry.Create;    SkrivScanningLogFil(msg);
   AReg.RootKey := HKEY_LOCAL_MACHINE;  
   if AReg.KeyExists('\SOFTWARE\Adobe\Acrobat Reader') then  
     result:= True;  
   AReg.Free;  
4808  end;  end;
4809    
 procedure TMainForm.CheckPrintQue(tjektype : string);  
 type  
   TJobs  = array [0..1000] of JOB_INFO_1;  
   PJobs = ^TJobs;  
 var  
   hPrinter: THandle;  
   bytesNeeded, numJobs, i: Cardinal;  
   pJ: PJobs;  
   printerTxt, statusTxt, dokumentTxt: String;  
 begin  
4810    
4811  // tjektype = 'Opstart' skal vise alarmlinie, samt opdatere listbox1  //Nedarvet fra IParentForm
4812  //            'Test'  skal vise alarmlinie, samt opdatere listbox1  procedure TMainForm.SetPrinterstatusText( txt: string; alert: boolean);
4813  //            'Timer' skal kun vise alarmlinie  begin
4814    
4815    if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then    PrinterstatusStaticText1.Caption := txt;
4816    begin    if (alert) then
     printerTxt := 'Der er fravalgt printer i dette program';  
     ListBox1.Items.Insert(0,printerTxt);  
     SkrivScanningLogFil(printerTxt);  
   end  
   else if (Printer.Printers.Count = 0) and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then  
4817    begin    begin
4818      printerTxt := 'Der er ikke installeret en printer på denne PC';      PrinterstatusStaticText1.Font.Color := clBlack;
4819      ListBox1.Items.Insert(0,printerTxt);      PrinterstatusStaticText1.Color := MainForm.Color;
4820      SkrivScanningLogFil(printerTxt);      PrinterstatusStaticText1.Transparent := True;
4821    end    end
4822    else    else
4823    begin    begin
4824      hPrinter := GetCurrentPrinterHandle;      PrinterstatusStaticText1.Font.Color := clRed;
4825      try      PrinterstatusStaticText1.Color := clWhite;
4826        EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded, numJobs);      PrinterstatusStaticText1.Transparent := true;
       pJ := AllocMem(bytesNeeded);  
       if not EnumJobs(hPrinter, 0, 1000, 1, pJ, bytesNeeded, bytesNeeded, numJobs) then  
         RaiseLastWin32Error;  
   
       if numJobs = 0 then  
       begin  
         if (tjektype = 'Test') then  
         begin  
           logTekst := printerTxt + ': Ingen dokumenter i kø';  
           ListBox1.Items.Insert(0,logTekst);  
           SkrivScanningLogFil(logTekst);  
         end;  
         PrinterstatusStaticText1.Caption := '';  
         PrinterstatusStaticText1.Color := MainForm.Color;  
       end  
       else   // så er der kø til printeren  
       begin  
         printerTxt := SavePChar(pJ^[0].pPrinterName);  
         if (tjektype = 'Opstart') or (tjektype = 'Test') then  
         begin  
           logTekst := IntToStr(numJobs) + ' dokument(er) i kø til printer: ' + printerTxt;  
           ListBox1.Items.Insert(0,logTekst);  
           SkrivScanningLogFil(logTekst);  
         end;  
         for i := 0 to Pred(numJobs) do  
         begin  
           printerTxt := SavePChar(pJ^[i].pPrinterName);  
           statusTxt := 'Ukendt';  
           if (IntToStr(pJ^[i].Status) = '0') then  
             statusTxt := 'Venter...';  
           if (IntToStr(pJ^[i].Status) = '4096') then  
             statusTxt := 'Printer...';  
           if (IntToStr(pJ^[i].Status) = '8210') then  
             statusTxt := 'Printerfejl';  
           if (IntToStr(pJ^[i].Status) = '8214') then  
             statusTxt := 'Sletter print...';  
   
           dokumentTxt := SavePChar(pJ^[i].pDocument);  
           if (dokumentTxt = '') then  
             dokumentTxt := 'Uden navn';  
   
           if (tjektype = 'Opstart') or (tjektype = 'Test') then  
           begin  
             logTekst := Format('Printer %s, Dokument %d: %s, Status (%d): %s',  
                                     [printerTxt, i+1, dokumentTxt, pJ^[i].Status, statusTxt]);  
             ListBox1.Items.Insert(0,logTekst);  
             SkrivScanningLogFil(logTekst);  
           end;  
   
           if (i = 0) then  
           begin  
             PrinterstatusStaticText1.Caption := printerTxt + ': ' + IntToStr(numJobs) + ' dokument(er) in kø. Dokument status: ' + statusTxt;  
             PrinterstatusStaticText1.Font.Color := clBlack;  
             PrinterstatusStaticText1.Color := MainForm.Color;  
             PrinterstatusStaticText1.Transparent := True;  
             if (numJobs > 3) then  
             begin  
               PrinterstatusStaticText1.Font.Color := clRed;  
               PrinterstatusStaticText1.Color := clWhite;  
               PrinterstatusStaticText1.Transparent := true;  
             end;  
           end;  
   
         end;  
       end  
       finally  
         ClosePrinter(hPrinter);  
     end;  
4827    end;    end;
4828  end;  end;
4829    
4830  function TMainForm.CheckUrl(url:string):boolean;  //Nedarvet fra IParentForm
4831  var  function TMainForm.GetFormObject() : TForm;
   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;  
4832  begin  begin
4833     with Control do    Result := self;
    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;  
4834  end;  end;
 // 20150310: slut  
4835    
4836  end.  end.
4837    
Legend:
Removed from v.2660  
changed lines
  Added in v.2792
  ViewVC Help
Powered by ViewVC 1.1.20