unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Printers, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, xmldom, XMLIntf, msxmldom, XMLDoc, IniFiles, AppEvnts,
Menus, ExtCtrls, ComCtrls, StrUtils, MMSystem, DateUtils,
IdExplicitTLSClientServerBase, IdFTP, pngimage, GIFImg, IdException,
Winspool, Registry, ShellApi, ClipBrd, Buttons, wininet
;
type
TStrArray = array of string;
TMainForm = class(TForm)
StregkodeST: TStaticText;
RuteNummerST: TStaticText;
BoghandlerNavnST: TStaticText;
IdHTTP1: TIdHTTP;
XMLDocument1: TXMLDocument;
ApplicationEvents1: TApplicationEvents;
chkSporgEfterKunde: TCheckBox;
KommentarST: TStaticText;
MainMenu1: TMainMenu;
N1: TMenuItem;
Pakkernormal1: TMenuItem;
ReturpakkerfraDAO1: TMenuItem;
Returpakkerfraboghandler1: TMenuItem;
Hjlp1: TMenuItem;
Om1: TMenuItem;
Testforbindelsen1: TMenuItem;
Testprinter1: TMenuItem;
Afslut1: TMenuItem;
Sprgefterboghandlernummer1: TMenuItem;
Lukprogrammet1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
radioStorPakke: TRadioButton;
radioLillePakke: TRadioButton;
N4: TMenuItem;
Storepakker1: TMenuItem;
Smpakker1: TMenuItem;
Panel1: TPanel;
Testlyd2: TMenuItem;
Button1: TButton;
Testlyd1: TMenuItem;
ListBox1: TListBox;
Budlevering1: TMenuItem;
DownloadButton01: TButton;
IdFTP1: TIdFTP;
Image1: TImage;
ListBox2: TListBox;
OpdaterListenButton01: TButton;
UploadButton01: TButton;
DownloadButton03: TButton;
Pakkeshoplevering1: TMenuItem;
PakkeshopText1: TStaticText;
PakkeshopNulstil: TButton;
Returpakkerfrapakkeshop1: TMenuItem;
Altidprintepakkelabel1: TMenuItem;
chkAltidPrintLabel: TCheckBox;
EKLoverforsel: TButton;
N5: TMenuItem;
Uploadlogfil1: TMenuItem;
Manual1: TMenuItem;
PrinterstatusStaticText1: TStaticText;
Timer1: TTimer;
chkScanTjekkode: TCheckBox;
Scanogstjekkoden1: TMenuItem;
Automatisktjekkodestyring1: TMenuItem;
Automatiskvalg1: TMenuItem;
PanelValgA: TPanel;
PanelValg1: TPanel;
PanelValg2: TPanel;
PanelValg3: TPanel;
PanelValg4: TPanel;
PanelValg5: TPanel;
PanelValg6: TPanel;
PanelValg7: TPanel;
Manualgenerel1: TMenuItem;
StaticTextManglendePakker: TStaticText;
PanelManglendePakker1: TPanel;
PanelManglendePakker2: TPanel;
PanelManglendePakker3: TPanel;
PanelManglendePakker4: TPanel;
PanelManglendePakker5: TPanel;
PanelManglendePakker6: TPanel;
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;
function getProddato() : TDate;
function getProddag() : 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;
procedure PlaySound(filename : PWideChar);
procedure StartScreen();
procedure InitScreen();
procedure InitBladhus();
procedure UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, Boghnr : String);
procedure InitLillePakke();
procedure InitStorPakke();
procedure InitForm(Farve,Titel,Url: String);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormCreate(Sender: TObject);
procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
procedure radioStorPakkeClick(Sender: TObject);
procedure radioLillePakkeClick(Sender: TObject);
procedure chkSporgEfterKundeClick(Sender: TObject);
procedure Pakkernormal1Click(Sender: TObject);
procedure Testforbindelsen1Click(Sender: TObject);
procedure Testprinter1Click(Sender: TObject);
procedure Om1Click(Sender: TObject);
procedure Lukprogrammet1Click(Sender: TObject);
procedure Sprgefterboghandlernummer1Click(Sender: TObject);
procedure ReturpakkerfraDAO1Click(Sender: TObject);
procedure Returpakkerfraboghandler1Click(Sender: TObject);
procedure Storepakker1Click(Sender: TObject);
procedure Smpakker1Click(Sender: TObject);
procedure Testlyd1Click(Sender: TObject);
procedure Testlyd2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ListBox1DrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
procedure Budlevering1Click(Sender: TObject);
procedure DownloadButton01Click(Sender: TObject);
procedure OpdaterListenButton01Click(Sender: TObject);
procedure DownloadBladhusRuteskiftfil();
procedure DownloadBladhusKontrolfil();
procedure SendFilTilDAO(fil_type, filnavn_input, filnavn_output: String);
procedure UploadLogfilTilDAO();
procedure UploadInifilTilDAO();
procedure SletStregkodelinieFraListboks2(StregKode : String);
procedure FormDestroy(Sender: TObject);
procedure UploadButton01Click(Sender: TObject);
procedure DownloadButton03Click(Sender: TObject);
procedure Pakkeshoplevering1Click(Sender: TObject);
procedure PakkeshopNulstilClick(Sender: TObject);
procedure Returpakkerfrapakkeshop1Click(Sender: TObject);
procedure InitNatxpresslevering();
procedure InitReturFraDao();
procedure InitReturFraKunde();
procedure InitDirektelevering();
procedure InitPakkeshoplevering();
procedure InitReturFraPakkeshop();
procedure InitIndleveringskode();
procedure Altidprintepakkelabel1Click(Sender: TObject);
procedure chkAltidPrintLabelClick(Sender: TObject);
procedure EKLoverforselClick(Sender: TObject);
procedure Uploadlogfil1Click(Sender: TObject);
procedure Manual1Click(Sender: TObject);
procedure CheckPrintQue(tjektype : string);
procedure Timer1Timer(Sender: TObject);
procedure Scanogstjekkoden1Click(Sender: TObject);
procedure chkScanTjekkodeClick(Sender: TObject);
procedure Automatisktjekkodestyring1Click(Sender: TObject);
procedure SendInfoTilServer(Sted, Scanningtype, Infotype, Info : String);
procedure Automatiskvalg1Click(Sender: TObject);
procedure PanelValgAClick(Sender: TObject);
procedure PanelValg1Click(Sender: TObject);
procedure PanelValg2Click(Sender: TObject);
procedure PanelValg3Click(Sender: TObject);
procedure PanelValg4Click(Sender: TObject);
procedure PanelValg5Click(Sender: TObject);
procedure PanelValg6Click(Sender: TObject);
procedure PanelValg7Click(Sender: TObject);
procedure NulstilAutomatiskValg();
procedure SletLogfiler(Path: string; FileList: TStrings);
procedure Manualgenerel1Click(Sender: TObject);
procedure TjekkerUrls();
// 20150310: start
procedure RoundCornerOf(Control: TWinControl);
// 20150310: slut
private
SpecialVersionSted, SpecialVersionScanningtype: String; // Bruges når programmet skal bruges udenfor DAO scanningssteder
Stregkode : String;
SkrivLog : String;
Sted : String;
StedNavn : String;
Url, UrlNormal, UrlReturDAO, UrlReturBoghandler, UrlBudlevering, UrlManglendeScanninger, UrlPakkeshoplevering, UrlReturPakkeshop, UrlPakkeshopManglendeScanninger, UrlPakkeshopManglendeReturScanninger,UrlEKLoverforsel : String;
// 29150330: start
UrlEKLoverforselPakkeshop : String;
// 20150330: slut
UrlFindPakketype, UrlSendPrograminfo: String;
Scanningtype, TestFunktionen, Pakketype, SporgEfterBoghandler : String;
ScanTjekkode : String;
ScanTjekkodeAutomatik : string;
Farve, FarveNormal, FarveReturDAO, FarveReturBoghandler, FarveBudlevering, FarvePakkeshoplevering, FarveReturPakkeshop, FarveIndlevering : String;
Titel, TitelNormal, TitelReturDAO, TitelReturBoghandler, TitelBudlevering, TitelPakkeshoplevering, TitelReturPakkeshop, TitelIndlevering : String;
LabelType : integer;
AlarmLyd : String;
ScannetOkLyd : String;
ScannetOkStorLyd : String;
// 20150317: start
ScannetOkTilTjekkodeLyd : String;
// 20150317: slut
PrinterNavn : String;
TjekPrinter : String;
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;
Org_RuteNummerST, Org_BoghandlerNavnST, Org_KommentarST : String;
BladhusSted : Integer;
BladhusStedKode : Array of string;
BladhusStedNavn : Array of string;
BladhusRuteskiftfil_server : String;
BladhusRuteskiftfil_lokal : String;
BladhusKontrolfil_server : String;
BladhusKontrolfil_lokal : String;
logTekst : string;
PakkeshopStregkode, PakkeshopTjekkode : String;
BoghandlerStregkode, BoghandlerTjekkode : String;
TjekUrls : String;
function CheckSumModulo10(const data:string):string; { used for EAN 8/13 }
procedure PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');
procedure SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
procedure HentPakkeInfoFraServer(const Sted, PakkeNr : String; var RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel: Boolean; BoghandlerNummer : String = '');
procedure CheckCode();
procedure IndlesManglendeScanninger();
procedure IndlesRuteskiftFil(var filnavn : string);
procedure IndlesKontrolFil(var filnavn : string);
procedure IndlesScanningLogFil();
procedure SkrivScanningLogFil(var tekst : string);
function TjekKoreliste(var RuteNummer, Koreliste : string) : string;
procedure VisAlarmSkaerm(strMessage: string);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
// Globale variabler
ruteHverdagArray : Array of String;
ruteLordagArray : Array of String;
ruteArray : Array of String;
korelisteArray : Array of String;
stregkoderMedTjekkodeArray : Array of String;
implementation
{$R *.dfm}
function TMainForm.TColorToHex(Color : TColor) : string;
begin
Result :=
IntToHex(GetRValue(Color), 2) +
IntToHex(GetGValue(Color), 2) +
IntToHex(GetBValue(Color), 2) ;
end;
function TMainForm.HexToTColor(sColor : string) : TColor;
begin
Result :=
RGB(
StrToInt('$'+Copy(sColor, 1, 2)),
StrToInt('$'+Copy(sColor, 3, 2)),
StrToInt('$'+Copy(sColor, 5, 2))
) ;
end;
procedure TMainForm.InitForm(Farve,Titel,Url : String);
begin
// 20150309: startr
StaticTextManglendePakker.Caption := '';
// 20150309: slut
PanelValg1.Color := clBtnFace;
if PanelValg1.Enabled = true then
begin
PanelValg1.Font.Color := clWindowText;
end;
PanelValg2.Color := clBtnFace;
if PanelValg2.Enabled = true then
begin
PanelValg2.Font.Color := clWindowText;
end;
PanelValg3.Color := clBtnFace;
if PanelValg3.Enabled = true then
begin
PanelValg3.Font.Color := clWindowText;
end;
PanelValg4.Color := clBtnFace;
if PanelValg4.Enabled = true then
begin
PanelValg4.Font.Color := clWindowText;
end;
PanelValg5.Color := clBtnFace;
if PanelValg5.Enabled = true then
begin
PanelValg5.Font.Color := clWindowText;
end;
PanelValg6.Color := clBtnFace;
if PanelValg6.Enabled = true then
begin
PanelValg6.Font.Color := clWindowText;
end;
PanelValg7.Color := clBtnFace;
if PanelValg7.Enabled = true then
begin
PanelValg7.Font.Color := clWindowText;
end;
OpdaterListenButton01.Enabled := false;
if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
begin
if (StedNavn = '') then
begin
Titel := BladhusStedNavn[BladhusSted]+': '+Titel;
end
else
begin
Titel := StedNavn+': '+Titel;
end;
//Farve := 'D8D8D8'; // her kan vi evt. overrule ini fil
end
else
begin
//ShowMessage(Sted);
if (StedNavn = '') then
begin
if (Sted = 'B') then
begin StedNavn := 'Brabrand: '; end
else if (Sted = 'E') then
begin StedNavn := 'Erritsø: '; end
else if (Sted = 'AAL') then
begin StedNavn := 'Aalborg: '; end
else if (Sted = 'BR') then
begin StedNavn := 'Brøndby: '; end
else if (Sted = 'BK') then
begin StedNavn := 'Bladkompagniet: '; end
else if (Sted = 'DBK') then
begin StedNavn := 'DBK Køge: '; end
else if (Sted = '1') then
begin StedNavn := 'Ålborg: '; end
else if (Sted = '2') then
begin StedNavn := 'Herning: '; end
else if (Sted = '3') then
begin StedNavn := 'Hinnerup: '; end
else if (Sted = '4') then
begin StedNavn := 'Vejle: '; end
else
begin StedNavn := Sted+': '; end
end
else
begin
if (RightStr(StedNavn,2) <> ': ') then
begin
StedNavn := StedNavn + ': ';
end;
end;
Titel := Stednavn + Titel;
end;
StartScreen();
MainForm.Caption := Titel;
MainForm.Color := HexToTColor(Farve);
MainForm.Farve := Farve;
MainForm.Titel := Titel;
MainForm.Url := Url;
if PrinterstatusStaticText1.Color <> clWhite then // Hvis der IKKE er en alarm skal vi tilpasse baggrundsfarven her
begin
PrinterstatusStaticText1.Color := MainForm.Color;
end;
if PakkeshopLevering1.Checked or Pakkernormal1.Checked then
PakkeshopText1.Visible := true
else
PakkeshopText1.Visible := false;
chkScanTjekkode.Checked := false;
chkScanTjekkode.Enabled := false;
Scanogstjekkoden1.Enabled := false;
if (Scanningtype = '1') or (Scanningtype = '5') then
begin
if (ScanTjekkode = '1') then
begin
chkScanTjekkode.Checked := true;
chkScanTjekkode.Enabled := true;
Scanogstjekkoden1.Enabled := true;
end
else
begin
chkScanTjekkode.Checked := false;
chkScanTjekkode.Enabled := true; // False vil forhindre indtastning af tjekkode i nat x-press scanning
Scanogstjekkoden1.Enabled := true; // False vil forhindre indtastning af tjekkode i nat x-press scanning
end;
end;
if Automatisktjekkodestyring1.Checked then
begin
chkScanTjekkode.Enabled := false;
Scanogstjekkoden1.Enabled := false;
end;
logTekst := 'Overskrift: '+Titel;
SkrivScanningLogFil(logTekst);
if SpecialVersionSted = '' then
begin
logTekst := 'Sted: '+Sted+', Stednavn: '+StringReplace(Stednavn, ':', '', [rfReplaceAll, rfIgnoreCase]);
SkrivScanningLogFil(logTekst);
end;
if SpecialVersionSted <> '' then
begin
if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
begin
if Stednavn = '' then
begin
logTekst := 'Speciel version til: '+BladhusStedNavn[BladhusSted]+' ('+BladhusStedKode[BladhusSted]+')';
end
else
begin
logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';
end;
SkrivScanningLogFil(logTekst);
end
else
begin
logTekst := 'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';
SkrivScanningLogFil(logTekst);
end;
end;
end;
procedure TMainForm.Altidprintepakkelabel1Click(Sender: TObject);
begin
if Altidprintepakkelabel1.Checked then
begin
chkAltidPrintLabel.Checked := true;
end
else
begin
chkAltidPrintLabel.Checked := false;
end;
end;
procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean);
begin
StregkodeST.Caption := Stregkode;
end;
procedure TMainForm.Automatisktjekkodestyring1Click(Sender: TObject);
begin
if Automatisktjekkodestyring1.Checked then
begin
chkScanTjekkode.Enabled := false;
Scanogstjekkoden1.Enabled := false;
end
else
begin
chkScanTjekkode.Enabled := true;
Scanogstjekkoden1.Enabled := true;
end;
end;
procedure TMainForm.Automatiskvalg1Click(Sender: TObject);
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;
*)
// Skal ikke toggle men bare sætte funktionen on
// Fravælges ved at vælge en scanningstype
AutomatiskValg1.Checked := true;
PanelValgA.Color := clGreen;
PanelValgA.Font.Color := clWhite;
// 20150317: slut
end;
procedure TMainForm.FormCreate(Sender: TObject);
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
printerInd : integer;
i : Integer;
// 20150310: start
gemScanningtype : String;
// 20150310: slut
begin
// Initierer nogle variabler
BladhusSted := 00;
Application.ShowHint := True;
PrinterstatusStaticText1.Caption := '';
PrinterstatusStaticText1.Color := MainForm.Color;
PakkeshopNulstil.BringToFront;
RoundCornerOf(PanelManglendePakker1);
RoundCornerOf(PanelManglendePakker2);
RoundCornerOf(PanelManglendePakker3);
RoundCornerOf(PanelManglendePakker4);
RoundCornerOf(PanelManglendePakker5);
RoundCornerOf(PanelManglendePakker6);
// Hvis mappen Docs eksisterer kan vi vælge Manual i menuen Hjælp
if DirectoryExists('Docs') then
begin
Manualgenerel1.Enabled := true;
Manual1.Enabled := true;
end;
// Sætter lige en default panel størrelse
MainForm.ClientWidth := 1000;
MainForm.ClientHeight := 750;
// Læser parametre fra ini filen
with TIniFile.Create(ChangeFileExt(Application.ExeName,'.ini')) do
try
SkrivLog := ReadString('Settings','SkrivLog','0');
Sted := ReadString('Settings','Sted','');
StedNavn := ReadString('Settings','Stednavn','');
UrlFindPakketype := ReadString('Settings','UrlFindPakketype','http://omdeling.info/webservices/bogpakkekontrol/FindPakketype.php?stregkode=%s');
UrlSendPrograminfo := ReadString('Settings','UrlSendPrograminfo','http://omdeling.info/webservices/bogpakkekontrol/SendPrograminfo.php?programnavn=%s&sted=%s&scanningtype=%s&infotype=%s&info=%s');
UrlNormal := ReadString('Settings','UrlNormal','http://omdeling.info/webservices/bogpakkekontrol/bogpakkekontrol.php?sted=%s&pakkenummer=%s&boghandlernummer=%s&tjekkode=%s');
UrlReturDAO := ReadString('Settings','UrlReturDAO','http://omdeling.info/webservices/bogpakkekontrol/bogpakkekontrol.php?sted=%s&pakkenummer=%s&boghandlernummer=%s&returpakketype=%s&pakkestorrelse=%s');
UrlReturBoghandler := ReadString('Settings','UrlReturBoghandler','http://omdeling.info/webservices/bogpakkekontrol/bogpakkekontrol.php?sted=%s&pakkenummer=%s&boghandlernummer=%s&returpakketype=%s&pakkestorrelse=%s');
UrlBudlevering := ReadString('Settings','UrlBudlevering','http://omdeling.info/webservices/bogpakkekontrol/bogpakkekontrol.php?sted=%s&pakkenummer=%s&leveringstype=%s&pakkestorrelse=%s');
UrlManglendeScanninger := ReadString('Settings','UrlManglendeScanninger','http://omdeling.info/webservices/bogpakkekontrol/bogpakkemanglendescanninger.php?sted=%s&type=%s');
UrlEKLoverforsel := ReadString('Settings','UrlEKLoverforsel','http://omdeling.info/webservices/bogpakkekontrol/bogpakkertilekl.php?sted=%s');
UrlEKLoverforselPakkeshop := ReadString('Settings','UrlEKLoverforselPakkeshop','http://omdeling.info/webservices/pakkeshop/pakkertilekl.php?sted=%s');
UrlPakkeshoplevering := ReadString('Settings','UrlPakkeshoplevering','http://omdeling.info/webservices/pakkeshop/pakkekontrol.php?sted=%s&stregkode=%s&tjekkode=%s');
UrlReturPakkeshop := ReadString('Settings','UrlReturPakkeshop','http://omdeling.info/webservices/pakkeshop/returpakkekontrol.php?sted=%s&stregkode=%s');
UrlPakkeshopManglendeScanninger := ReadString('Settings','UrlPakkeshopManglendeScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendescanninger.php?sted=%s');
UrlPakkeshopManglendeReturScanninger := ReadString('Settings','UrlPakkeshopManglendeReturScanninger','http://omdeling.info/webservices/pakkeshop/pakkemanglendereturscanninger.php?sted=%s');
LabelType := ReadInteger('Settings','LabelType',1);
FarveNormal := ReadString('Settings','FarveNormal','D8D8D8');
TitelNormal := ReadString('Settings','TitelNormal','Modtagelse af DAO NAT X-PRESS pakker');
FarveReturDAO := ReadString('Settings','FarveReturDAO','A9F5A9');
TitelReturDAO := ReadString('Settings','TitelReturDAO','Returforsendelse fra DAO');
FarveReturBoghandler := ReadString('Settings','FarveReturBoghandler','F2F5A9');
TitelReturBoghandler := ReadString('Settings','TitelReturBoghandler','Returforsendelse fra boghandler');
FarveBudlevering := ReadString('Settings','FarveBudlevering','2E9AFE');
TitelBudlevering := ReadString('Settings','TitelBudlevering','Modtagelse af DAO DIREKTE pakker');
FarvePakkeshoplevering := ReadString('Settings','FarvePakkeshoplevering','99FFFF');
TitelPakkeshoplevering := ReadString('Settings','TitelPakkeshoplevering','Modtagelse af DAO PAKKESHOP pakker');
FarveReturPakkeshop := ReadString('Settings','FarveReturPakkeshop','99FFCC');
TitelReturPakkeshop := ReadString('Settings','TitelReturPakkeshop','Returforsendelse fra pakkeshop');
FarveIndlevering := ReadString('Settings', 'FarveIndlevering', 'E5B2CB');
TitelIndlevering := ReadString('Settings', 'TitelIndlevering', 'Indleveringskode');
SporgEfterBoghandler := ReadString('Settings','SporgEfterBoghandler','0');
ScanTjekkode := ReadString('Settings','ScanTjekkode','0');
ScanTjekkodeAutomatik := ReadString('Settings','ScanTjekkodeAutomatik','1');
Scanningtype := ReadString('Settings','Scanningtype','A');
Pakketype := ReadString('Settings','Pakketype','0');
TestFunktionen := ReadString('Settings','TestFunktion','0');
AlarmLyd := ReadString('Settings','AlarmLyd','Sounds\Alarm.wav');
ScannetOkLyd := ReadString('Settings','ScannetOkLyd','Sounds\Ok.wav');
ScannetOkStorLyd := ReadString('Settings','ScannetOkStorLyd','Sounds\Ok_stor.wav');
ScannetOkTilTjekkodeLyd := ReadString('Settings','ScannetOkTilTjekkodeLyd','Sounds\Ok_til_tjekkode.wav');
PrinterNavn := ReadString('Settings','PrinterNavn','');
TjekPrinter := ReadString('Settings','TjekPrinter','1');
TjekUrls := ReadString('Settings','TjekUrls','2');
if (SkrivLog = '1') then
begin
logTekst := 'Program start (Version: ' + Sto_GetFmtFileVersion('','') + ') Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',now);
try
SkrivScanningLogFil(logTekst);
Uploadlogfil1.Enabled := true;
UploadButton01.Enabled := true;
logTekst := 'Programmet er installeret som: '+ParamStr(0);
SkrivScanningLogFil(logTekst);
// Oprydning i gamle logfiler
SletLogfiler('Logs\', ListBox1.Items);
except
SkrivLog := '0';
end;
end;
if Scanningtype = 'A' then
begin
Automatiskvalg1.Checked := true;
Scanningtype := '1';
PanelValgA.Color := clGreen;
PanelValgA.Font.Color := clWhite;
end;
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;
if SporgEfterBoghandler = '1' then
begin
chkSporgEfterKunde.Checked := true;
Sprgefterboghandlernummer1.Checked := true;
end
else
begin
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
end;
if ScanTjekkode = '1' then
begin
chkScanTjekkode.Checked := true;
Scanogstjekkoden1.Checked := true;
end
else
begin
chkScanTjekkode.Checked := false;
Scanogstjekkoden1.Checked := false;
end;
if ScanTjekkodeAutomatik = '1' then
begin
Automatisktjekkodestyring1.Checked := true;
chkScanTjekkode.Enabled := false;
Scanogstjekkoden1.Enabled := false;
end;
//
// specialversioner
//
// Hvis programmet skal bruges af andre distributører/scanningssteder end DAO
// skal vi ikke bruge hele ini-filen.
// Vi laver derfor en speciel opsætning her.
SpecialVersionSted := ''; // Tom indikerer normal version hvor scanningtype er angivet i ini filen
SpecialVersionScanningtype := 'A'; // 'Automatisk valg'
// bruges sammen med nedenstående SpecialVersionSted for specialversioner af programmet
// Ved compilering af en specialversion skal efterfølgende
// 2 felter sættes efter behov (SpecialVersionSted og SpecialVersionScanningtype).
// Det er p.t. ikke nødvendigt at ændre andre steder...
// *************************** //
//SpecialVersionSted := 'BK'; // bruges sammen med ovenstående SpecialVersionScanningtype 'Automatisk valg')
//SpecialVersionSted := 'DBK'; // bruges sammen med ovenstående SpecialVersionScanningtype 'Automatisk valg')
//SpecialVersionSted := 'NS'; // NS - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
//SpecialVersionSted := 'FD'; // FD - sætter automatisk nedenstående SpecialVersionScanningtype til DIREKTE)
// *************************** //
//SpecialVersionSted := '01'; // NS - bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
//SpecialVersionSted := '02'; // BK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted BK)
//SpecialVersionSted := '03'; // FD - (bruges sammen med nedenstående SpecialVersionScanningtype DIREKTE)
//SpecialVersionSted := '04'; // DBK - BRUGES IKKE (brug i stedet ovenstående SpecialVersionSted DBK)
//SpecialVersionScanningtype := '1'; // NAT X-PRESS (BRUGES IKKE)
//SpecialVersionScanningtype := '2'; // Retur fra DAO (BRUGES IKKE)
//SpecialVersionScanningtype := '3'; // Retur fra Kunde (BRUGES IKKE)
//SpecialVersionScanningtype := '4'; // DIREKTE
//SpecialVersionScanningtype := '5'; // PAKKESHOP (BRUGES IKKE)
//SpecialVersionScanningtype := '6'; // Retur fra pakkeshop (BRUGES IKKE)
// Hvis specialversion er valgt (SpecialVersionSted er sat til en værdi ovenfor)
// ændrer vi Sted og Scanningtype her:
// 20150313: start
if SpecialVersionSted = 'NS' then
begin
SpecialVersionSted := '01';
SpecialVersionScanningtype := '4';
end;
if SpecialVersionSted = 'FD' then
begin
SpecialVersionSted := '03';
SpecialVersionScanningtype := '4';
end;
// 20150313: slut
if SpecialVersionSted = 'BK' then
begin
//FarveNormal := 'A9F5A9'; // her kan vi evt. overrule ini fil
Sted := SpecialVersionSted;
// her skal vi også disable de knapper BK ikke kan bruge
PanelValg2.Enabled := false;
PanelValg2.Font.Color := clInactiveCaption;
PanelValg3.Enabled := false;
PanelValg3.Font.Color := clInactiveCaption;
PanelValg6.Enabled := false;
PanelValg6.Font.Color := clInactiveCaption;
// her skal vi også disable de menupunkter BK ikke kan bruge
ReturpakkerfraDAO1.Enabled := false;
Returpakkerfraboghandler1.Enabled := false;
Returpakkerfrapakkeshop1.Enabled := false;
if SpecialVersionScanningtype = 'A' then
begin
Scanningtype := '1';
end
else
begin
Scanningtype := SpecialVersionScanningtype;
end;
end;
if SpecialVersionSted = 'DBK' then
begin
//FarveNormal := 'A9F5A9'; // her kan vi evt. overrule ini fil
Sted := SpecialVersionSted;
// her skal vi også disable de knapper DBK ikke kan bruge
PanelValg2.Enabled := false;
PanelValg2.Font.Color := clInactiveCaption;
PanelValg3.Enabled := false;
PanelValg3.Font.Color := clInactiveCaption;
PanelValg5.Enabled := false;
PanelValg5.Font.Color := clInactiveCaption;
PanelValg6.Enabled := false;
PanelValg6.Font.Color := clInactiveCaption;
// her skal vi også disable de menupunkter DBK ikke kan bruge
ReturpakkerfraDAO1.Enabled := false;
Returpakkerfraboghandler1.Enabled := false;
Pakkeshoplevering1.Enabled := false;
Returpakkerfrapakkeshop1.Enabled := false;
if SpecialVersionScanningtype = 'A' then
begin
Scanningtype := '1';
end
else
begin
Scanningtype := SpecialVersionScanningtype;
end;
end;
if (SpecialVersionSted = '01')
or (SpecialVersionSted = '02')
or (SpecialVersionSted = '03')
or (SpecialVersionSted = '04') then
begin
BladhusSted := StrToInt(SpecialVersionSted);
// her skal vi også disable de knapper 01, 02, 03 og 04 (NS, BK, FD og DBK) ikke kan bruge
PanelValg1.Enabled := false;
PanelValg1.Font.Color := clInactiveCaption;
PanelValg2.Enabled := false;
PanelValg2.Font.Color := clInactiveCaption;
PanelValg3.Enabled := false;
PanelValg3.Font.Color := clInactiveCaption;
PanelValg4.Enabled := false;
PanelValg4.Font.Color := clInactiveCaption;
PanelValg5.Enabled := false;
PanelValg5.Font.Color := clInactiveCaption;
PanelValg6.Enabled := false;
PanelValg6.Font.Color := clInactiveCaption;
// her skal vi også disable de menupunkter Bladhusene (01, 02, 03 og 04) ikke kan bruge
Automatiskvalg1.Enabled := false;
Pakkernormal1.Enabled := false;
ReturpakkerfraDAO1.Enabled := false;
Returpakkerfraboghandler1.Enabled := false;
Budlevering1.Enabled := false;
Pakkeshoplevering1.Enabled := false;
Returpakkerfrapakkeshop1.Enabled := false;
if SpecialVersionScanningtype = 'A' then
begin
Scanningtype := '4';
Budlevering1.Enabled := true;
PanelValg4.Font.Color := clWindowText;
PanelValg4.Enabled := true;
end
else
begin
Scanningtype := SpecialVersionScanningtype;
PanelValgA.Enabled := false;
PanelValgA.Font.Color := clInactiveCaption;
AutomatiskValg1.Checked := false;
PanelValgA.Color := clBtnFace;
if Scanningtype = '1' then
begin
Pakkernormal1.Enabled := true;
PanelValg1.Enabled := true;
PanelValg1.Font.Color := clWindowText;
end;
if Scanningtype = '2' then
begin
ReturpakkerfraDAO1.Enabled := true;
PanelValg2.Enabled := true;
PanelValg2.Font.Color := clWindowText;
end;
if Scanningtype = '3' then
begin
Returpakkerfraboghandler1.Enabled := true;
PanelValg3.Enabled := true;
PanelValg3.Font.Color := clWindowText;
end;
if Scanningtype = '4' then
begin
Budlevering1.Enabled := true;
PanelValg4.Enabled := true;
PanelValg4.Font.Color := clWindowText;
end;
if Scanningtype = '5' then
begin
Pakkeshoplevering1.Enabled := true;
PanelValg5.Enabled := true;
PanelValg5.Font.Color := clWindowText;
end;
if Scanningtype = '6' then
begin
Returpakkerfrapakkeshop1.Enabled := true;
PanelValg6.Enabled := true;
PanelValg6.Font.Color := clWindowText;
end;
end;
Sted := SysUtils.Format('%.*d', [2, BladhusSted]);
//FarveBudlevering := '2E9AFE'; // her kan vi evt. overrule ini fil
end;
SetLength(BladhusStedNavn, 5);
SetLength(BladhusStedKode, 5);
BladhusStedNavn[00] := 'bruges ikke';
BladhusStedKode[00] := '';
BladhusStedNavn[01] := 'Nordjyske';
BladhusStedKode[01] := 'NS';
BladhusStedNavn[02] := 'Bladkompagniet';
BladhusStedKode[02] := 'BK';
BladhusStedNavn[03] := 'Fyens Distribution';
BladhusStedKode[03] := 'FD';
BladhusStedNavn[04] := 'DBK Køge';
BladhusStedKode[04] := 'DBK';
if (Trim(Sted) = '')
or (Length(Sted) > 3) then
begin
ShowMessage('Scanningsted "' + Sted + '" er ukendt - programmet afbrydes...');
Application.Terminate;
end;
if TjekUrls = '1' then // Tjekker urls
begin
TjekkerUrls();
if TjekUrls = '-' then // så var der fejl i url - så vi stopper her
begin
PlaySound(PWideChar(AlarmLyd));
MainForm.Color := clRed;
RutenummerST.Caption := '';
BoghandlerNavnST.Caption := 'Fejl i urls';
KommentarST.Caption := 'Se log vinduet';
PakkeshopNulstil.Visible := true;
exit;
end;
end
else
begin // Tjekker ikke urls
logTekst := 'Tjekker IKKE urls i denne afvikling.';
SkrivScanningLogFil(logTekst);
end;
if Scanningtype = '6' then
begin
InitReturFraPakkeshop();
end
else if Scanningtype = '5' then
begin
InitPakkeshoplevering();
end
else if Scanningtype = '4' then
begin
InitDirektelevering();
end
else if Scanningtype = '3' then
begin
InitReturFraKunde();
end
else if Scanningtype = '2' then
begin
InitReturFraDao();
end
else if (Scanningtype = '1') then
begin
InitNatxpressLevering();
end
else
begin
ShowMessage('Scanningtype er af ukendt type - programmet afbrydes...');
Application.Terminate;
end;
if Pakketype = '1' then
begin
Storepakker1.Checked := true;
radioStorPakke.Checked := true;
end
else
begin
Smpakker1.Checked := true;
radioLillePakke.Checked := true;
end;
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;
if not FileExists(AlarmLyd) then
begin
AlarmLyd := '';
end;
if not FileExists(ScannetOkLyd) then
begin
ScannetOkLyd := '';
end;
if not FileExists(ScannetOkStorLyd) then
begin
ScannetOkStorLyd := '';
end;
if not FileExists(ScannetOkTilTjekkodeLyd) then
begin
ScannetOkTilTjekkodeLyd := '';
end;
if (PrinterNavn <> '') then
begin
printerInd := Printer.Printers.IndexOf(printerNavn);
if printerInd >= 0 then
Printer.PrinterIndex := printerInd;
end;
CheckPrintQue('Opstart');
finally
Free;
end;
// UBD skal p.t. ikke have adgang til flg. funktioner
if ( (Sted = '1') or (Sted = '2') or (Sted = '3') or (Sted = '4') ) then
begin
ReturpakkerfraDAO1.Visible := false;
Returpakkerfraboghandler1.Visible := false;
Budlevering1.Visible := false;
Storepakker1.Visible := false;
Smpakker1.Visible := false;
Testprinter1.Visible := false;
Pakkeshoplevering1.Visible := false;
Returpakkerfrapakkeshop1.Visible := false;
end;
if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
begin
InitBladhus();
end;
// Opbygger PanelManglendePakker information
gemScanningtype := Scanningtype;
if PanelValg6.Enabled then
begin
Scanningtype := '6';
IndlesManglendeScanninger();
end;
if PanelValg5.Enabled then
begin
Scanningtype := '5';
IndlesManglendeScanninger();
end;
if PanelValg4.Enabled then
begin
Scanningtype := '4';
IndlesManglendeScanninger();
end;
if PanelValg3.Enabled then
begin
Scanningtype := '3';
IndlesManglendeScanninger();
end;
if PanelValg2.Enabled then
begin
Scanningtype := '2';
IndlesManglendeScanninger();
end;
if PanelValg1.Enabled then
begin
Scanningtype := '1';
IndlesManglendeScanninger();
end;
Scanningtype := gemScanningtype;
SendInfoTilServer(Sted, Scanningtype, 'Begin', '');
SendInfoTilServer(Sted, Scanningtype, 'ProgramVersion', Sto_GetFmtFileVersion('',''));
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
logTekst := 'Program slut';
SkrivScanningLogFil(logTekst);
SendInfoTilServer(Sted, Scanningtype, 'End', '');
end;
procedure TMainForm.FormKeyPress(Sender: TObject; var Key: Char);
var
RuteNummer : String;
Kommentar : String;
BoghandlerNavn : String;
Koreliste : String;
PrintNyLabel : Boolean;
pakkeErScannet : Integer;
pakkeForkertSted : Integer;
tjekkodeMangler : Integer;
SmsKode : String;
DBKbane : String;
Leveringssted : String;
i : Integer;
ClipboardData : String;
numberString : string;
float : Extended;
errorPos : Integer;
GemStregkode : String;
WebSvar : String;
URLStr : String;
Pakketype : String;
Pakkescanningtype : String;
//List1msg : String;
begin
if Key = #22 then // ctrl-v
begin
ClipboardData := Clipboard.AsText;
numberString := ClipboardData;
Val(numberString, float, errorPos);
// if (ClipboardData <> '') and (errorPos = 0) then
if (ClipboardData <> '') and (errorPos = 0)
or (NumberString = 'Nulstil')
or (NumberString = 'Indtast kundenummer')
or (NumberString = 'Stor pakke')
or (NumberString = 'Lille pakke')
or (NumberString = 'Scan tjekkode')
or (NumberString = 'Automatisk valg')
or (NumberString = 'DAO NAT X-PRESS')
or (NumberString = 'DAO NAT X+PRESS') // 20150323: pga stregkode programmet bruger et forkert karaktersæt
or (NumberString = 'Retur fra DAO')
or (NumberString = 'Retur fra kunde')
or (NumberString = 'DAO DIREKTE')
or (NumberString = 'DAO PAKKESHOP')
or (NumberString = 'Retur fra pakkeshop') then
begin
Stregkode := Stregkode + ClipboardData;
StregkodeST.Caption := StregKode;
end
else
begin
ShowMessage('Indsæt et gyldigt pakkenummer - uden linieskift');
end;
end;
if Key = #13 then // Enter
begin
if (Length(Trim(Stregkode)) = 0) then
begin
VisAlarmSkaerm( 'Der skal scannes en stregkode...' );
exit;
end;
if StregKode = 'Nulstil' then
begin
PakkeshopNulstil.Click();
exit;
end;
if PakkeshopNulstil.Visible then
begin
VisAlarmSkaerm( 'HUSK at klikke Nulstil før ny scanning...' );
exit;
end;
if StregKode = 'Lille pakke' then
begin
if radioLillePakke.Enabled = true then
begin
InitLillePakke();
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'Stor pakke' then
begin
if radioStorPakke.Enabled = true then
begin
InitStorPakke();
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'Indtast kundenummer' then
begin
if chkSporgEfterKunde.Enabled = true then
begin
if (chkSporgEfterKunde.State = cbChecked) then
begin
chkSporgEfterKunde.State := cbUnchecked;
end
else
begin
chkSporgEfterKunde.State := cbChecked;
end;
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if (Stregkode = 'Scan tjekkode') or (PakkeshopStregkode = 'Scan tjekkode') or (BoghandlerStregkode = 'Scan tjekkode') then
begin
if chkScanTjekkode.Enabled = true then
begin
if (chkScanTjekkode.State = cbChecked) then
begin
chkScanTjekkode.State := cbUnchecked;
end
else
begin
chkScanTjekkode.State := cbChecked;
end;
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'Automatisk valg' then
begin
if (PanelValgA.Enabled = true) then
begin
PanelValgAClick(PanelValgA);
end
else
begin
VisAlarmSkaerm(Stregkode + ' kan ikke vælges på dette scanningsted');
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if (StregKode = 'DAO NAT X-PRESS' ) or (StregKode = 'DAO NAT X+PRESS') then
begin
if (PanelValg1.Enabled = true) then
begin
PanelValg1Click(PanelValg1);
end
else
begin
VisAlarmSkaerm(Stregkode + ' kan ikke vælges på dette scanningsted');
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'Retur fra DAO' then
begin
if (PanelValg2.Enabled = true) then
begin
PanelValg2Click(PanelValg2);
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'Retur fra kunde' then
begin
if (PanelValg3.Enabled = true) then
begin
PanelValg3Click(PanelValg3);
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'DAO DIREKTE' then
begin
if (PanelValg4.Enabled = true) then
begin
PanelValg4Click(PanelValg4);
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'DAO PAKKESHOP' then
begin
if (PanelValg5.Enabled = true) then
begin
PanelValg5Click(PanelValg5);
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if StregKode = 'Retur fra pakkeshop' then
begin
if (PanelValg6.Enabled = true) then
begin
PanelValg6Click(PanelValg6);
end
else
begin
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
end;
Stregkode := '';
StregkodeST.Caption := StregKode;
exit;
end;
if (Length(Stregkode) > 8) then
begin
// Her skal vi så forespørge pakketype på serveren udfra stregkode feltet
URLStr := Format(UrlFindPakketype,[Stregkode]);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
WebSvar := IdHTTP1.Get(URLStr);
//IdHTTP1.Disconnect();
except on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
logTekst := 'EIdConnClosedGracefully i FindPakketype';
SkrivScanningLogFil(logTekst);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
WebSvar := IdHTTP1.Get(URLStr);
except on e:EIdConnClosedGracefully do
begin
logTekst := 'EIdConnClosedGracefully i FindPakketype igen';
SkrivScanningLogFil(logTekst);
WebSvar := IdHTTP1.Get(URLStr);
end;
end;
end;
end;
XMLDocument1.LoadFromXML(WebSvar);
try
Pakketype := XMLDocument1.ChildNodes.FindNode('BogpakkePakketype').ChildNodes.FindNode('PakkeType').Text;
except on e:exception do
Pakketype := 'Ukendt';
end;
try
Pakkescanningtype := XMLDocument1.ChildNodes.FindNode('BogpakkePakketype').ChildNodes.FindNode('PakkeScanningtype').Text;
except on e:exception do
Pakketype := 'Ukendt';
end;
if Pakketype = 'Ukendt' then
begin
Pakkescanningtype := Scanningtype;
end;
end
else
begin
Pakkescanningtype := Scanningtype;
end;
if ( (Pakkescanningtype = '1') and (PanelValg1.Enabled = false)
or (Pakkescanningtype = '2') and (PanelValg2.Enabled = false)
or (Pakkescanningtype = '3') and (PanelValg3.Enabled = false)
or (Pakkescanningtype = '4') and (PanelValg4.Enabled = false)
or (Pakkescanningtype = '5') and (PanelValg5.Enabled = false)
or (Pakkescanningtype = '6') and (PanelValg6.Enabled = false) ) then
begin // Her skal komme en alarm og rød skærm
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
exit;
end;
if Automatiskvalg1.Checked and (Length(Stregkode) > 8) then
begin
GemStregkode := Stregkode;
if Pakketype = 'NatXpress' then
begin
if Scanningtype <> '1' then
begin
Scanningtype := '1';
InitNatxpresslevering();
end;
end
// Retur kan ikke scannes med 'Automatisk valg'
else if Pakketype = 'Direkte' then
begin
if Scanningtype <> '4' then
begin
Scanningtype := '4';
InitDirektelevering();
end;
end
else if Pakketype = 'Pakkeshop' then
begin
if Scanningtype <> '5' then
begin
Scanningtype := '5';
InitPakkeshoplevering();
end;
end
// Retur kan ikke scannes med 'Automatisk valg'
else
begin
// Her skal komme en alarm og rød skærm
VisAlarmSkaerm( Stregkode + ' kan ikke vælges på dette scanningsted' );
exit;
end;
Stregkode := GemStregkode;
end
else if Automatiskvalg1.Checked and (PakkeshopText1.Caption = 'Stregkode') then
begin
VisAlarmSkaerm( 'Pakkenummer ikke gyldigt (for kort)' );
exit;
end;
if not Automatiskvalg1.Checked then
begin
if ( (Pakkescanningtype <> Scanningtype) and (Scanningtype <> '2') and (Scanningtype <> '3') ) then
begin
VisAlarmSkaerm( 'Pakke findes som pakketype: ' + Pakketype );
exit;
end;
end;
if (PakkeshopText1.Visible = true) and (PakkeshopText1.Caption = 'Stregkode') and Automatisktjekkodestyring1.Checked then
begin
chkScanTjekkode.Checked := false;
for i := 0 to length(stregkoderMedTjekkodeArray)-1 do
begin
if (Stregkode=stregkoderMedTjekkodeArray[i]) then
begin
chkScanTjekkode.Checked := true;
Scanogstjekkoden1.Checked := true;
end;
end;
end;
if Pakkernormal1.Checked and not Scanogstjekkoden1.Checked then
begin
// Når vi ikke kræver tjekkode er alt ok her
BoghandlerStregkode := Stregkode;
BoghandlerTjekkode := '';
PakkeshopText1.Caption := 'Stregkode';
PakkeshopNulstil.Visible := false;
Stregkode := '';
InitScreen();
end
else if (PakkeshopLevering1.Checked or Pakkernormal1.Checked) and not Scanogstjekkoden1.Checked then
begin
// Når vi ikke kræver tjekkode er alt ok her
PakkeshopStregkode := Stregkode;
PakkeshopTjekkode := '-1';
BoghandlerStregkode := Stregkode;
BoghandlerTjekkode := '-1';
PakkeshopText1.Caption := 'Stregkode';
PakkeshopNulstil.Visible := false;
Stregkode := '';
InitScreen();
end
else if PakkeshopLevering1.Checked or Pakkernormal1.Checked then
if PakkeshopText1.Caption = 'Stregkode' then
begin
if length(Stregkode) > 5 then
begin
PakkeshopStregkode := Stregkode;
BoghandlerStregkode := Stregkode;
PakkeshopText1.Caption := 'Tjekkode';
PlaySound(PWideChar(ScannetOkTilTjekkodeLyd));
end
else
begin
VisAlarmSkaerm( 'Du skal scanne en stregkode' );
end;
Stregkode := '';
InitScreen();
end
else
begin
if length(Stregkode) = 5 then
begin
PakkeshopTjekkode := Stregkode;
BoghandlerTjekkode := Stregkode;
PakkeshopText1.Caption := 'Stregkode';
if (PakkeshopLevering1.Checked) then
MainForm.Color := HexToTColor(FarvePakkeshoplevering);
if (Pakkernormal1.Checked) then
MainForm.Color := HexToTColor(FarveNormal);
PakkeshopNulstil.Visible := false;
end
else
begin
if (PakkeshopLevering1.Checked) then
VisAlarmSkaerm('Du skal scanne en tjekkode til stregkode ' + PakkeshopStregkode);
if (Pakkernormal1.Checked) then
VisAlarmSkaerm('Du skal scanne en tjekkode til stregkode ' + BoghandlerStregkode);
StregKode := '';
StregkodeST.Caption := StregKode;
exit;
end;
Stregkode := '';
InitScreen();
end;
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
begin
if PakkeshopLevering1.Checked and (PakkeshopStregkode <> '') and (PakkeshopTjekkode <> '') then
StregKode := PakkeshopStregkode;
if Pakkernormal1.Checked and ((BoghandlerStregkode <> '') and (BoghandlerTjekkode <> '') or not Scanogstjekkoden1.Checked) then
StregKode := BoghandlerStregkode;
StregkodeST.Caption := StregKode;
try
InitScreen();
HentPakkeInfoFraServer(Sted, StregKode, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, '');
UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, '');
// Hvis der var sql fejl i opdateringen skal dette fejlmeldes her
if Rutenummer = 'sql fejl' then
begin // Her skal komme en alarm og rød skærm
PlaySound(PWideChar(AlarmLyd));
//List1msg := 'SQL fejl: ' + Kommentar;
//ListBox1.Items.Insert(0,List1Msg);
MainForm.Color := clRed;
//KommentarST.Caption := List1msg;
PakkeshopNulstil.Visible := true;
exit;
end;
if (Pakkernormal1.Checked or Budlevering1.Checked or PakkeshopLevering1.Checked) then
begin
PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel);
pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
if pakkeErScannet = 0 then
begin
pakkeErScannet := pos('PAKKE ER SCANNET', Kommentar);
end;
if pakkeErScannet = 0 then
begin
pakkeErScannet := pos('PAKKE ER SCANNET', BoghandlerNavn);
end;
pakkeForkertSted := pos('burde være hos', Kommentar);
tjekkodemangler := pos('Tjekkode mangler', Kommentar);
if (pakkeErScannet > 0) or (pakkeForkertSted > 0) or (tjekkodemangler > 0) then
begin
PlaySound(PWideChar(AlarmLyd));
PakkeshopNulstil.Visible := true;
MainForm.Color := clRed;
end;
end;
if ( Pakkernormal1.Checked and (pakkeErScannet = 0) and (pakkeForkertSted = 0) and (tjekkodemangler = 0) and (RuteNummerST.Caption <> 'Ukendt') ) or (Copy(Kommentar,1,2) = 'Ok') then
begin
MainForm.Color := HexToTColor(Farve);
if Storepakker1.Checked then
begin
PlaySound(PWideChar(ScannetOkStorLyd));
end
else
begin
PlaySound(PWideChar(ScannetOkLyd));
end;
PakkeshopNulstil.Visible := false;
end
else if (Returpakkerfradao1.Checked or Returpakkerfraboghandler1.Checked) then
begin
MainForm.Color := HexToTColor(Farve);
if Storepakker1.Checked then
begin
PlaySound(PWideChar(ScannetOkStorLyd));
end
else
begin
PlaySound(PWideChar(ScannetOkLyd));
end;
PakkeshopNulstil.Visible := false;
end
else if Copy(Kommentar,1,8) = 'OPRETTET' then
begin
VisAlarmSkaerm( 'Pakke ' + PakkeshopStregkode + ' skal gemmes på lager indtil data modtages' );
end
else if Kommentar = StregKode then // budlevering til 'Ukendt tur'
begin
end
else
begin
MainForm.Color := clRed;
PlaySound(PWideChar(AlarmLyd));
PakkeshopNulstil.Visible := true;
end;
if not PakkeshopNulstil.Visible then
begin
If (Budlevering1.Checked) then
begin
if Storepakker1.Checked then
begin
PlaySound(PWideChar(ScannetOkStorLyd));
end
else
begin
PlaySound(PWideChar(ScannetOkLyd));
end;
InitLillePakke();
end;
end;
SletStregkodelinieFraListboks2(StregKode);
PakkeshopStregkode := '';
PakkeshopTjekkode := '';
BoghandlerStregkode := '';
BoghandlerTjekkode := '';
finally
Stregkode := '';
end
end
end
else
begin
if (Key <> #22) then
begin
Stregkode := Stregkode + Key;
end;
StregkodeST.Caption := StregKode;
end;
if Key = #8 then // backspace key
begin
StregKode := LeftStr(StregKode,Length(StregKode)-2);
end;
if Key = #27 then // esc key
begin
Stregkode := '';
end;
Key := #0;
end; //End of OnKeyPress
procedure TMainForm.SendInfoTilServer(Sted, Scanningtype, Infotype, Info : String);
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
WebSvar : String;
URLStr : String;
begin
if UrlSendPrograminfo <> '' then
begin
URLStr := Format(UrlSendPrograminfo,[ExtractFileName(ParamStr(0)), Sted, Scanningtype, Infotype, Info]);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
WebSvar := IdHTTP1.Get(URLStr);
//IdHTTP1.Disconnect();
except on e:exception do
begin
// ShowMessage(e.Message);
// raise exception.CreateFmt('Fejl i forbindelse til server: %s',[e.Message]);
logTekst := 'Der er opstået en fejl i kommunikationen med serveren.' + crlf + crlf + 'Programmet afsluttes... ' + crlf + crlf + 'Program rutine: SendTilServeren' + crlf + 'Fejl: ' + e.Message;
ShowMessage(logTekst);
SkrivScanningLogFil(logTekst);
// Vi nulstiller lige url feltet så rutinen ikke kaldes igen i forbindelse med lukning af programmet
UrlSendPrograminfo := '';
Application.Terminate;
end;
end;
if (WebSvar <> '') and (pos('Error', WebSvar) > 0) then
begin
ShowMessage(WebSvar);
end;
end;
end;
procedure TMainForm.SletStregkodelinieFraListboks2(StregKode : String);
var
i : Integer;
wrkAntal : String;
wrkAntalIdag, wrkAntalSenere : Integer;
begin
if Budlevering1.Checked or Pakkeshoplevering1.Checked or Returpakkerfrapakkeshop1.Checked or Pakkernormal1.Checked then
begin
for i := ListBox2.items.count-1 downto 0 do
if pos(StregKode,ListBox2.items[i]) <> 0 then
begin
// Ajourføring af tæller for manglende pakker (scanninger)
wrkAntal := StaticTextManglendePakker.Caption;
if (pos('/', wrkAntal) > 0) then // både pakker idag og senere
begin
wrkAntal := wrkAntal + '/'; // tilføjer '/' sidst i feltet af hensyn til split funktionen
wrkAntalIdag := StrToInt(split(wrkAntal, '/', 2));
// ShowMessage(SPLIT('data/another/yet/again/more/','/',3));
// ShowMessage(SPLIT('data/another/','/',3));
// ShowMessage(SPLIT('data/another','/',3));
wrkAntalSenere := StrToInt(split(wrkAntal, '/', 3));
end
else // kun idag
begin
wrkAntalIdag := StrToInt(wrkAntal);
end;
if pos(StregKode + ' (',ListBox2.items[i]) <> 0 then // pakke til senere levering
begin
//ShowMessage('Senere ' + IntToStr(wrkAntalIdag) + ' ' + IntToStr(wrkAntalSenere));
wrkAntalSenere := wrkAntalSenere - 1;
// StaticTextManglendePakker.Caption := IntToStr(wrkAntalIdag) + '/' + IntToStr(wrkAntalSenere);
end
else
begin
// ShowMessage('Idag');
wrkAntalIdag := wrkAntalIdag - 1;
// StaticTextManglendePakker.Caption := IntToStr(wrkAntalIdag);
end;
if (wrkAntalSenere > 0) then
begin
StaticTextManglendePakker.Caption := IntToStr(wrkAntalIdag) + '/' + IntToStr(wrkAntalSenere);
end
else
begin
StaticTextManglendePakker.Caption := IntToStr(wrkAntalIdag);
end;
if (Scanningtype = '1') then
begin
PanelManglendePakker1.Caption := IntToStr(wrkAntalIdag + wrkAntalSenere);
if (wrkAntalIdag + wrkAntalSenere > 0) then
begin
PanelManglendePakker1.Visible := true;
end
else
begin
PanelManglendePakker1.Visible := false;
end;
end;
if (Scanningtype = '2') then
begin
PanelManglendePakker2.Caption := IntToStr(wrkAntalIdag + wrkAntalSenere);
if (wrkAntalIdag + wrkAntalSenere > 0) then
begin
PanelManglendePakker2.Visible := true;
end
else
begin
PanelManglendePakker2.Visible := false;
end;
end;
if (Scanningtype = '3') then
begin
PanelManglendePakker3.Caption := IntToStr(wrkAntalIdag + wrkAntalSenere);
if (wrkAntalIdag + wrkAntalSenere > 0) then
begin
PanelManglendePakker3.Visible := true;
end
else
begin
PanelManglendePakker3.Visible := false;
end;
end;
if (Scanningtype = '4') then
begin
PanelManglendePakker4.Caption := IntToStr(wrkAntalIdag + wrkAntalSenere);
if (wrkAntalIdag + wrkAntalSenere > 0) then
begin
PanelManglendePakker4.Visible := true;
end
else
begin
PanelManglendePakker4.Visible := false;
end;
end;
if (Scanningtype = '5') then
begin
PanelManglendePakker5.Caption := IntToStr(wrkAntalIdag + wrkAntalSenere);
if (wrkAntalIdag + wrkAntalSenere > 0) then
begin
PanelManglendePakker5.Visible := true;
end
else
begin
PanelManglendePakker5.Visible := false;
end;
end;
if (Scanningtype = '6') then
begin
PanelManglendePakker6.Caption := IntToStr(wrkAntalIdag + wrkAntalSenere);
if (wrkAntalIdag + wrkAntalSenere > 0) then
begin
PanelManglendePakker6.Visible := true;
end
else
begin
PanelManglendePakker6.Visible := false;
end;
end;
// 20150310: slut
ListBox2.items.delete(i);
end;
end;
end;
procedure TMainForm.StartScreen();
begin
if Org_RuteNummerST = '' then
Org_RuteNummerST := RuteNummerST.Caption;
if Org_BoghandlerNavnST = '' then
Org_BoghandlerNavnST := BoghandlerNavnST.Caption;
if Org_KommentarST = '' then
Org_KommentarST := KommentarST.Caption;
RuteNummerST.Caption := Org_RuteNummerST;
BoghandlerNavnST.Caption := Org_BoghandlerNavnST;
KommentarST.Caption := Org_KommentarST;
end;
procedure TMainForm.InitScreen();
begin
RuteNummerST.Caption := '';
KommentarST.Caption := '';
BoghandlerNavnST.Caption := '';
end;
procedure TMainForm.InitBladhus();
var
LogFilnavn : string;
begin
Altidprintepakkelabel1.Enabled := false;
Pakkernormal1.Visible := false;
ReturpakkerfraDAO1.Visible := false;
Returpakkerfraboghandler1.Visible := false;
Sprgefterboghandlernummer1.Enabled := false;
ListBox1.Visible := true;
// TestFunktionen := '1';
// 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
if Budlevering1.Checked then
begin
IndlesScanningLogFil();
end;
//
// Bladhus ***
//
case BladhusSted of
01 :
begin; // NS
Testprinter1.Visible := true;
DownloadButton01.Enabled := true;
OpdaterListenButton01.Enabled := true;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
BladhusKontrolfil_server := 'franordjyske/RuteKontrol.txt';
BladhusKontrolfil_lokal := 'RuteKontrol.txt';
DownloadBladhusKontrolfil();
IndlesManglendeScanninger();
end;
02 :
begin; // BK
Testprinter1.Visible := true;
Smpakker1.Enabled := true;
Storepakker1.Enabled := true;
radioStorPakke.Enabled := true;
radioLillePakke.Enabled := true;
DownloadButton01.Enabled := false; // kontrolfil bruges ikke her
OpdaterListenButton01.Enabled := true;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
IndlesManglendeScanninger();
end;
03 :
begin; // FD
Testprinter1.Visible := true;
if (getProddag() = 'lørdag') then
begin
DownloadButton03.Visible := false;
end
else
begin
DownloadButton03.Visible := false;
end;
DownloadButton01.Enabled := true;
OpdaterListenButton01.Enabled := true;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
BladhusRuteskiftfil_server := 'frafd/RuteSkift.txt';
BladhusRuteskiftfil_lokal := 'RuteSkift.txt';
if (getProddag() = 'lørdag') then
begin
//DownloadBladhusRuteskiftfil(); // Skal ikke bruges endnu
end;
BladhusKontrolfil_server := 'frafd/RuteKontrol.txt';
BladhusKontrolfil_lokal := 'RuteKontrol.txt';
DownloadBladhusKontrolfil();
IndlesManglendeScanninger();
end;
04 : begin; // DBK
Testprinter1.Visible := true;
Smpakker1.Enabled := true;
Storepakker1.Enabled := true;
radioStorPakke.Enabled := true;
radioLillePakke.Enabled := true;
DownloadButton01.Enabled := false; // kontrolfil bruges ikke her
OpdaterListenButton01.Enabled := true;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
end;
else
//ShowMessage('Ukendt Bladhus sted ???') ;
end;
end;
procedure TMainForm.HentPakkeInfoFraServer(const Sted, PakkeNr : String; var RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : String = '');
var
WebSvar : String;
URLStr : String;
pakkestorrelse : String;
PrintNyLabelInteger : Integer;
begin
if radioStorPakke.Checked then
begin
pakkestorrelse := 'Stor';
end;
if radioLillePakke.Checked then
begin
pakkestorrelse := 'Lille';
end;
if Pakkernormal1.Checked then
begin
if (BoghandlerTjekkode = '') then
begin
BoghandlerTjekkode := '-1';
end;
URLStr := Format(UrlNormal,[Sted, PakkeNr, BoghandlerNummer, BoghandlerTjekkode]);
end
else if ReturpakkerfraDAO1.Checked then
begin
URLStr := Format(UrlReturDAO,[Sted, PakkeNr, BoghandlerNummer, 'DAO', pakkestorrelse]);
end
else if Returpakkerfraboghandler1.Checked then
begin
URLStr := Format(UrlReturBoghandler,[Sted, PakkeNr, BoghandlerNummer, 'Boghandler', pakkestorrelse]);
end
else if Budlevering1.Checked then
begin
URLStr := Format(UrlBudlevering,[Sted, PakkeNr, 'bud', pakkestorrelse]);
end
else if Pakkeshoplevering1.Checked then
begin
URLStr := Format(UrlPakkeshoplevering,[Sted, PakkeNr, PakkeshopTjekkode]);
end
else if Returpakkerfrapakkeshop1.Checked then
begin
URLStr := Format(UrlReturPakkeshop,[Sted, PakkeNr]);
end
else
begin
exit;
end;
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
WebSvar := IdHTTP1.Get(URLStr);
//IdHTTP1.Disconnect();
except on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
logTekst := 'EIdConnClosedGracefully i HentPakkeInfoFraServer';
SkrivScanningLogFil(logTekst);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
WebSvar := IdHTTP1.Get(URLStr);
except on e:EIdConnClosedGracefully do
begin
logTekst := 'EIdConnClosedGracefully i HentPakkeInfoFraServer igen';
SkrivScanningLogFil(logTekst);
WebSvar := IdHTTP1.Get(URLStr);
end;
end;
end;
end;
XMLDocument1.LoadFromXML(WebSvar);
try
if Pakkeshoplevering1.Checked or Returpakkerfrapakkeshop1.Checked then
begin
RuteNummer := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('PakkeshopTurid').Text;
Kommentar := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('Stregkodematch').Text;
BoghandlerNavn := XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('PakkeshopNr').Text;
BoghandlerNavn := BoghandlerNavn + ' ' + XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('PakkeshopNavn').Text;
PrintNyLabel := False;
if Pakkeshoplevering1.Checked then
begin
try
PrintNyLabelInteger := StrToInt(XMLDocument1.ChildNodes.FindNode('PakkeKontrol').ChildNodes.FindNode('PakkeshopPrintPakkeLabel').Text);
except on e:exception do
PrintNyLabelInteger := 0;
end;
if (PrintNyLabelInteger = 1) then
begin
PrintNyLabel := True;
end;
// 20150310: start
end;
// 20150310: slut
end
else
begin
RuteNummer := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('TurId').Text;
Koreliste := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('Koreliste').Text;
Kommentar := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('Kommentar').Text;
BoghandlerNavn := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('BoghandlerNavn').Text;
Leveringssted := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('Leveringssted').Text;
if Budlevering1.Checked then
begin
try
SmsKode := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('SmsKode').Text;
except on e:exception do
SmsKode := '';
end;
try
DBKbane := XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('DBKbane').Text;
except on e:exception do
DBKbane := '';
end;
end;
PrintNyLabel := False;
try
PrintNyLabelInteger := StrToInt(XMLDocument1.ChildNodes.FindNode('BogpakkeKontrol').ChildNodes.FindNode('PrintPakkeLabel').Text);
except on e:exception do
PrintNyLabelInteger := 0;
end;
PrintNyLabel := False;
if (PrintNyLabelInteger = 1) then
begin
PrintNyLabel := True;
end;
end;
if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
begin
if (Leveringssted <> BladhusStedKode[BladhusSted]) and (BladhusStedKode[BladhusSted] <> 'DBK') then
begin
Kommentar := Kommentar + ' Pakke burde være hos DAO Distribution';
PrintNyLabel := False;
end;
end
else if (Budlevering1.Checked) and (Leveringssted <> Sted) then
begin
if (Leveringssted = 'E') and (Sted = 'DBK') then
begin
// Det er ok at DBK scanner pakker til E (Schenker)
end
else
begin
Kommentar := Kommentar + ' Pakke burde være hos DAO Distribution';
PrintNyLabel := False;
end;
end;
except on e:exception do
raise exception.CreateFmt('Fejl i XML-format: %s',[e.Message]);
end;
end;
procedure TMainForm.UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, BoghNr : String);
var
List1Msg, List1Pakkestorrelse : String;
begin
RuteNummerST.Caption := RuteNummer;
KommentarST.Caption := Kommentar;
KommentarST.Caption := StringReplace(Kommentar, #$A, ' - ', [rfReplaceAll, rfIgnoreCase]);
KommentarST.Caption := StringReplace(KommentarST.Caption, ' & ', ' && ', [rfReplaceAll, rfIgnoreCase]);
//Label1.Caption := Kommentar; // bruges hvis der skal vises linieskift - det kan man ikke i en staticText
BoghandlerNavnST.Caption := StringReplace(BoghandlerNavn, ' & ', ' && ', [rfReplaceAll, rfIgnoreCase]);
List1msg := TimeToStr(now) + '; ';
if Pakkeshoplevering1.Checked then
List1msg := List1msg + PakkeshopStregkode + ' ' + PakkeshopTjekkode + '; ' + KommentarST.Caption + '; ';
List1Pakkestorrelse := '';
if radioStorPakke.Checked then
begin
List1Pakkestorrelse := 'Stor pakke';
end;
if radioLillePakke.Checked then
begin
List1Pakkestorrelse := 'Lille pakke';
end;
List1msg := List1msg + BoghandlerNavn + '; ';
if ReturpakkerfraDAO1.Checked then
begin
List1msg := List1msg + RightStr(Kommentar, Length(Kommentar)-8);
end;
if Returpakkerfraboghandler1.Checked then
begin
List1msg := List1msg + RightStr(Kommentar, Length(Kommentar)-16);
end;
if ReturpakkerfraDAO1.Checked or Returpakkerfraboghandler1.Checked then
List1msg := List1msg + '; ' + List1Pakkestorrelse;
if length(BoghNr) > 0 then
begin
List1Msg := List1Msg + '; Indtastet ' + BoghNr;
end;
if Budlevering1.Checked then
begin
List1msg := TimeToStr(now) + '; ' + Kommentar + '; ' + BoghandlerNavn;
if (radioStorPakke.Checked) then
begin
List1msg := List1msg + '; Stor pakke';
end;
if (radioLillePakke.Checked) then
begin
List1msg := List1msg + '; Lille pakke';
end;
end;
if Returpakkerfrapakkeshop1.Checked then
begin
List1msg := List1msg + Stregkode + ' ' + RightStr(Kommentar, Length(Kommentar)-6);
end;
if Pakkernormal1.Checked then
begin
if (Kommentar = '***** Kommentar *****') // fra test printer funktionen
or (BoghandlerNavn = 'Forbindelse ok') // fra test forbindelse funktionen
or (BoghandlerNavn = 'Fejl i forbindelse til server') then // fra test forbindelse funktionen
begin
List1msg := List1msg + '; ' + Stregkode + '; ' + Kommentar;
end
else
begin
List1msg := List1msg + '; ' + Stregkode + ' (' + BoghandlerTjekkode + ')' + '; ' + Kommentar;
end;
end;
ListBox1.Items.Insert(0,List1Msg);
logTekst := RightStr(List1Msg, Length(List1Msg)-10);
SkrivScanningLogFil(logTekst);
end;
procedure TMainForm.UploadButton01Click(Sender: TObject);
begin
UploadLogfilTilDAO();
UploadInifilTilDAO();
ListBox1.SetFocus; // for at flytte fokus væk fra upload knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
end;
procedure TMainForm.PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted : String; var PrintNyLabel : Boolean; BoghandlerNummer : string = '');
var
ClickedOK: Boolean;
pakkeErScannet : Integer;
pakkeForkertSted : Integer;
List1Msg : String;
kontrolKoreliste : string;
nytRuteNummer, nyFarve : String;
begin
if Budlevering1.Checked then
RuteNummerST.Color := HexToTColor(Farve);
pakkeErScannet := pos('PAKKEN ER SCANNET', BoghandlerNavn);
if pakkeErScannet = 0 then
begin
pakkeErScannet := pos('PAKKE ER SCANNET', Kommentar);
end;
if pakkeErScannet = 0 then
begin
pakkeErScannet := pos('PAKKE ER SCANNET', BoghandlerNavn);
end;
pakkeForkertSted := pos('burde være hos', Kommentar);
if Sprgefterboghandlernummer1.Enabled and chkSporgEfterKunde.Checked and ( (RuteNummer = 'Ukendt') or (RuteNummer = 'Ukendt tur') or (RuteNummer = 'Retur ukendt') or (pakkeErScannet > 0) or (pakkeForkertSted > 0) ) then
begin
if (RuteNummer = 'Ukendt') then
begin
repeat
begin
ClickedOK := InputQuery('Ukendt pakke', 'Indtast kundenummer', BoghandlerNummer);
end
until (ClickedOK and (Length(BoghandlerNummer) > 2) and (Length(BoghandlerNummer) < 9)) or not ClickedOK;
if not ClickedOK then
begin
exit;
end;
if (Length(BoghandlerNummer) > 2) then
begin
InitScreen();
HentPakkeInfoFraServer(Sted, StregKode, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, BoghandlerNummer);
end;
end;
end
else
if Budlevering1.Checked then
begin
if (BoghandlerNavn = 'Ukendt pakke') then
begin
PrintNyLabel := false;
PlaySound(PWideChar(AlarmLyd));
MainForm.Color := clRed;
PakkeshopNulstil.Visible := true;
end
else
begin
nytRuteNummer := retRutenummer(RuteNummer);
if (nytRuteNummer <> RuteNummer) then
begin
PrintNyLabel := true;
RuteNummerST.Caption := RuteNummer+' -> ny rute: '+nytRuteNummer;
nyFarve := Farve;
RuteNummerST.Color := HexToTColor(nyFarve);
List1msg := TimeToStr(now) + '; ' + RuteNummer+' -> ny rute: '+nytRuteNummer;
RuteNummer := nytRuteNummer;
ListBox1.Items.Insert(0,List1Msg);
logTekst := RightStr(List1Msg, Length(List1Msg)-10);
SkrivScanningLogFil(logTekst);
if (PrinterNavn = 'Ingen') then
begin
PrintNyLabel := false;
end;
if (PrintNyLabel = false) then // Hvis vi ikke printer label skal vi vise en 'rød skærm' alarm
begin
PlaySound(PWideChar(AlarmLyd));
MainForm.Color := clRed;
PakkeshopNulstil.Visible := true;
end;
end;
kontrolKoreliste := TjekKoreliste(RuteNummer, Koreliste);
if (kontrolKoreliste <> RuteNummer) then
begin
PrintNyLabel := true;
List1msg := TimeToStr(now) + '; ' + BoghandlerNavn + '; ' + 'Forkert køreliste ' + '; ' + Koreliste + ' -> ' + kontrolKoreliste;
if (length(kontrolKoreliste) > 20) then // Skal ikke printe label når 'Køreliste ikke i kontrolfil'
begin
PrintNyLabel := false;
RuteNummerST.Caption := RuteNummerST.Caption + ' -> ' + kontrolKoreliste;
end
else
begin
RuteNummerST.Caption := RuteNummerST.Caption + ' -> Ny køreliste: ' + kontrolKoreliste;
end;
ListBox1.Items.Insert(0,List1Msg);
logTekst := RightStr(List1Msg, Length(List1Msg)-10);
SkrivScanningLogFil(logTekst);
if (PrintNyLabel = false) then // Hvis vi ikke printer label skal vi vise en 'rød skærm' alarm
begin
PlaySound(PWideChar(AlarmLyd));
MainForm.Color := clRed;
PakkeshopNulstil.Visible := true;
end;
end;
end;
end;
if Budlevering1.Checked then
begin
case BladhusSted of
00 : begin;
// 20150304: start
// if PrintNyLabel and (kontrolKoreliste <> '') or (RuteNummer = 'Rutenr') then
// // Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
// // Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
// // Det holder dog ikke for DAO DIREKTE fordi Schenker altid skal printes, da deres label mangler DAO ruteoplysninger553915076624451294
if PrintNyLabel or (RuteNummer = 'Rutenr') then
// 20150304: slut
begin
SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
end;
end;
01 : begin;
if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
// Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
// Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
begin
SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
end;
end;
02 : begin;
if PrintNyLabel or (RuteNummer = 'Rutenr') then // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test
begin
SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
end;
end;
03 : begin;
if PrintNyLabel and ( (kontrolKoreliste <> '') and (kontrolKoreliste <> RuteNummer) ) or (RuteNummer = 'Rutenr') then
// Ovenstående test er lidt speciel fordi der i programmet nogle steder er byttet rundt på rute og køreliste
// Meningen er at der kun skal printes hvis der er forskel i kørelisterne eller ruterne - eller vi kommer fra test funktionen (Rutenr = 'Rutenr')
begin
SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
end;
end;
04 : begin;
if PrintNyLabel or (RuteNummer = 'Rutenr') then // Hvis RuteNummer = 'Rutenr' er vi igang med en printer test
begin
SendTilPrinter(kontrolKoreliste, RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, PrintNyLabel, BoghandlerNummer);
end;
end;
else
ShowMessage('Ukendt Bladhus sted: ' + IntToStr(BladhusSted));
end;
end;
// Hvis det er normal bogpakke modtagelse til UBD skal vi p.t. ikke printe - men stopper her
if Pakkernormal1.Checked and ( (Sted = '1') or (Sted = '2') or (Sted = '3') or (Sted = '4') ) then
begin
exit;
end;
if Budlevering1.Checked or ( Sprgefterboghandlernummer1.Enabled and chkSporgEfterKunde.Checked and ( (RuteNummer = 'Ukendt') or (RuteNummer = 'Ukendt tur') or (RuteNummer = 'Retur ukendt') or (pakkeErScannet > 0) ) and (printNyLabel = false) ) then
begin
end
else
begin
if ( (PrinterNavn <> 'Ingen') and (PrintNyLabel or chkAltidPrintLabel.Checked) and (RuteNummer <> 'Ukendt') or (RuteNummer = 'Rutenr')) then
begin
logTekst := 'Printer label type ';
if (chkAltidPrintLabel.Checked) then
begin
logTekst := logTekst + 'Alle ';
end
else if (PrintNyLabel) then
begin
logTekst := logTekst + 'Rute ';
end
else
begin
logTekst := logTekst + 'Ukendt ';
end;
logTekst := logTekst + ' for '+BoghandlerNavn;
SkrivScanningLogFil(logTekst);
with Printer do
begin
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;
end;
end;
end;
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;
procedure TMainForm.radioStorPakkeClick(Sender: TObject);
begin
Storepakker1.Checked := true;
radioStorPakke.Checked := true;
end;
procedure TMainForm.radioLillePakkeClick(Sender: TObject);
begin
Smpakker1.Checked := true;
radioLillePakke.Checked := true;
end;
procedure TMainForm.chkSporgEfterKundeClick(Sender: TObject);
begin
if chkSporgEfterKunde.Checked then
begin
Sprgefterboghandlernummer1.Checked := true;
end
else
begin
Sprgefterboghandlernummer1.Checked := false;
end;
end;
procedure TMainForm.chkAltidPrintLabelClick(Sender: TObject);
begin
if chkAltidPrintLabel.Checked then
begin
Altidprintepakkelabel1.Checked := true;
end
else
begin
Altidprintepakkelabel1.Checked := false;
end;
end;
procedure TMainForm.chkScanTjekkodeClick(Sender: TObject);
begin
if chkScanTjekkode.Checked then
begin
Scanogstjekkoden1.Checked := true;
end
else
begin
Scanogstjekkoden1.Checked := false;
end;
end;
procedure TMainForm.Pakkeshoplevering1Click(Sender: TObject);
begin
Scanningtype := '5';
InitPakkeshoplevering();
NulstilAutomatiskValg();
end;
procedure TMainForm.NulstilAutomatiskValg();
begin
Automatiskvalg1.Checked := false;
PanelValgA.Color := clBtnFace;
PanelValgA.Font.Color := clWindowText;
if (SpecialVersionSted = '01')
or (SpecialVersionSted = '02')
or (SpecialVersionSted = '03')
or (SpecialVersionSted = '04') then
begin
// her skal vi også disable knappen for 01, 02, 03 og 04 (NS, BK, FD og DBK)
PanelValgA.Enabled := false;
PanelValgA.Font.Color := clInactiveCaption;
Automatiskvalg1.Enabled := false;
end;
// 20150317: slut
end;
procedure TMainForm.TjekkerUrls();
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
urlFejl : Integer;
begin
urlFejl := 0;
//UpdateScreen('', '', 'Tjekker forbindelsen...', '', ''); // virker ikke
ShowMessage('Tjekker data forbindelse til serveren.' + crlf + 'Det kan godt tage nogle minutter.' + crlf + 'Resultatet af testen vises i skærmbilledet...');
// Tjekker urls
logTekst := 'Tjekker urls.';
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
SkrivScanningLogFil(logTekst);
// 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;
// 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;
// Tjekker UrlReturBoghandler
if PanelValg3.Enabled = true then
begin
if CheckUrl(UrlReturBoghandler) then
begin
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;
// Tjekker UrlBudlevering
if PanelValg4.Enabled = true then
begin
if CheckUrl(UrlBudlevering) then
begin
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;
// Tjekker UrlPakkeshoplevering
if PanelValg5.Enabled = true then
begin
if CheckUrl(UrlPakkeshoplevering) then
begin
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;
// Tjekker UrlReturPakkeshop
if PanelValg6.Enabled = true then
begin
if CheckUrl(UrlReturPakkeshop) then
begin
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;
// Tjekker UrlManglendeScanninger
if (PanelValg1.Enabled = true)
or (PanelValg4.Enabled = true) then
begin
if CheckUrl(UrlManglendeScanninger) then
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;
// Tjekker UrlPakkeshopManglendeScanninger
if PanelValg5.Enabled = true then
begin
if CheckUrl(UrlPakkeshopManglendeScanninger) then
begin
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;
// Tjekker UrlPakkeshopManglendeReturScanninger
if PanelValg6.Enabled = true then
begin
if CheckUrl(UrlPakkeshopManglendeReturScanninger) then
begin
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;
// Tjekker UrlEKLoverforsel
if PanelValg1.Enabled = true then
begin
if CheckUrl(UrlEKLoverforsel) then
begin
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;
// Tjekker UrlEKLoverforselPakkeshop
if PanelValg5.Enabled = true then
begin
if CheckUrl(UrlEKLoverforselPakkeshop) then
begin
logTekst := 'UrlEKLoverforselPakkeshop accepteret: ' + UrlEKLoverforselPakkeshop;
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;
// 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;
// Tjekker UrlSendPrograminfo
if CheckUrl(UrlSendPrograminfo) then
begin
logTekst := 'UrlSendPrograminfo accepteret: ' + UrlSendPrograminfo;
SkrivScanningLogFil(logTekst);
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;
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;
end;
function TMainForm.FileTime2DateTime(FileTime: TFileTime): TDateTime;
var
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
begin
FileTimeToLocalFileTime(FileTime, LocalFileTime) ;
FileTimeToSystemTime(LocalFileTime, SystemTime) ;
Result := SystemTimeToDateTime(SystemTime) ;
end;
procedure TMainForm.SletLogfiler(Path: string; FileList: TStrings);
var
SR: TSearchRec;
dt: TDateTime;
CreationTime: TFileTime;
dtCreation: TDateTime;
BemTxt : String;
begin
logTekst := 'Logfiler tjekkes for sletning.';
SkrivScanningLogFil(logTekst);
FileList.Insert(0,logTekst);
if FindFirst(Path + '*.log', faAnyFile, SR) = 0 then // finder log filer
begin
repeat
if (SR.Attr <> faDirectory) then
begin
dt := fileDateToDateTime(SR.Time); // finder filens timestamp for seneste ændring
CreationTime := SR.FindData.ftCreationTime; // finder filens timestamp for oprettelse
dtCreation := FileTime2DateTime(CreationTime); // finder filens timestamp for oprettelse
// Selvom creation date godt kan være forskellig fra modified date,
// skal vi alligevel altid tjekke filens alder ud fra modified date
// (ændring den kan ligge både før og efter oprettelse, hvis filerne er flyttet eller ændret manuelt)
BemTxt := '';
if (DaysBetween(now, dt) > 14) then // så er filen kandidat til at blive slettet
begin
BemTxt := ' (skal slettes)';
end;
logTekst := SR.Name + ' Dato: ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',dt) + ' ' + BemTxt + ' ' + IntToStr(DaysBetween(now, dt)) + ' dage gammel';
if DaysBetween(dtCreation, dt) > 1 then
begin
logTekst := logTekst + ' (Oprettet ' + FormatDateTime('yyyy-mm-dd hh:nn:ss',dtCreation) + ')';
end;
FileList.Insert(0,logTekst);
SkrivScanningLogFil(logTekst);
if BemTxt = ' (skal slettes)' then
begin
if DeleteFile(Path + SR.Name) then
begin
logTekst := 'Logfil er slettet.';
FileList.Insert(0,logTekst);
SkrivScanningLogFil(logTekst);
end
else
begin
logTekst := 'Logfil kunne IKKE slettes.';
FileList.Insert(0,logTekst);
SkrivScanningLogFil(logTekst);
end;
end;
end;
until FindNext(SR) <> 0;
FindClose(SR);
end;
end;
procedure TMainForm.PakkeshopNulstilClick(Sender: TObject);
begin
PakkeshopStregkode := '';
PakkeshopTjekkode := '';
PakkeshopNulstil.Visible := false;
PakkeshopText1.Caption := 'Stregkode';
BoghandlerStregkode := '';
BoghandlerTjekkode := '';
Stregkode := '';
// 20150312: start
if BoghandlerNavnST.Caption = 'Fejl i forbindelse til server' then
begin
ShowMessage('Programmet afbrydes...');
UrlSendPrograminfo := ''; // Her sletter vi lige url, så der ikke forsøges at sende besked ved program slut
Application.Terminate;
exit;
end;
// 20150312: slut
InitScreen();
// MainForm.Color := HexToTColor(Farve);
if Farve <> '' then
begin
MainForm.Color := 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
end;
if (Budlevering1.Checked) then
begin
InitLillePakke();
end;
PrinterstatusStaticText1.Caption := '';
PrinterstatusStaticText1.Color := MainForm.Color;
end;
procedure TMainForm.PanelValg1Click(Sender: TObject);
begin
Scanningtype := '1';
InitNatxpresslevering();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValg2Click(Sender: TObject);
begin
Scanningtype := '2';
InitReturFraDao();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValg3Click(Sender: TObject);
begin
Scanningtype := '3';
InitReturFraKunde();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValg4Click(Sender: TObject);
begin
Scanningtype := '4';
InitDirektelevering();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValg5Click(Sender: TObject);
begin
Scanningtype := '5';
InitPakkeshoplevering();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValg6Click(Sender: TObject);
begin
Scanningtype := '6';
InitReturFraPakkeshop();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValg7Click(Sender: TObject);
begin
Scanningtype := '7';
InitIndleveringskode();
NulstilAutomatiskValg();
end;
procedure TMainForm.PanelValgAClick(Sender: TObject);
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;
*)
// Skal ikke toggle men bare sætte funktionen on
// Fravælges ved at vælge en scanningstype
AutomatiskValg1.Checked := true;
PanelValgA.Color := clGreen;
PanelValgA.Font.Color := clWhite;
// 20150311: slut
end;
procedure TMainForm.Pakkernormal1Click(Sender: TObject);
begin
Scanningtype := '1';
NulstilAutomatiskValg();
InitNatxpresslevering();
end;
procedure TMainForm.Testforbindelsen1Click(Sender: TObject);
var
RuteNummer : String;
Kommentar : String;
BoghandlerNavn : String;
Koreliste : String;
Falsk : Boolean;
Sand : Boolean;
SmsKode : String;
DBKbane : String;
Leveringssted : String;
orgTjekUrls : String;
begin
orgTjekUrls := TjekUrls;
if (TjekUrls = '1') or (TjekUrls = '2') then
begin
TjekkerUrls();
end;
if TjekUrls = '-' then
begin
//ShowMessage('Der var fejl i een eller flere urls - se logvinduet');
RuteNummer := '';
Kommentar := 'Se log vinduet';
BoghandlerNavn := 'Fejl i forbindelse til server';
Koreliste := '';
UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, '');
// Her kommer en alarm og rød skærm
PlaySound(PWideChar(AlarmLyd));
MainForm.Color := clRed;
PakkeshopNulstil.Visible := true;
end
else
begin
Falsk := False;
Sand := True;
HentPakkeInfoFraServer(Sted,'111111111100000', RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk, '');
UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, '');
SmsKode := '999999';
DBKbane := '999';
Leveringssted := 'XXX';
PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);
FocusControl(StregkodeST);
end;
TjekUrls := orgTjekUrls;
end;
procedure TMainForm.Testprinter1Click(Sender: TObject);
var
RuteNummer : String;
Kommentar : String;
BoghandlerNavn : String;
Koreliste : String;
Falsk : Boolean;
Sand : Boolean;
SmsKode : String;
DBKbane : String;
Leveringssted : String;
begin
RuteNummer := 'Rutenr';
Kommentar := '***** Kommentar *****';
BoghandlerNavn := 'Modtagernavn';
Falsk := False;
Sand := True;
if (Printer.Printers.Count = 0) then
begin
ShowMessage('Der er ikke installeret en printer på denne PC.');
end
else if PrinterNavn = 'Ingen' then
begin
ShowMessage('Der er fravalgt printer i dette program.');
end
else
begin
UpdateScreen(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, '');
SmsKode := '999999';
DBKbane := '999';
Leveringssted := 'XXX';
PrintLabel(RuteNummer, Kommentar, BoghandlerNavn, Koreliste, SmsKode, DBKbane, Leveringssted, Falsk);
CheckPrintQue('Test');
end;
FocusControl(StregkodeST);
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
if (TjekPrinter = '1') then
begin
CheckPrintQue('Timer');
end
else
begin
PrinterstatusStaticText1.Caption := '';
PrinterstatusStaticText1.Color := MainForm.Color;
end;
end;
{
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;
procedure TMainForm.Om1Click(Sender: TObject);
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
tekst, filversion : String;
begin
filversion := Sto_GetFmtFileVersion('','');
tekst := 'Program til indscanning af pakker'+crlf+'Version '+filversion+crlf+crlf+'Udviklet af it afdelingen, DAO';
tekst := tekst+crlf+crlf;
tekst := tekst+'Programmet er installeret som:'+crlf+ParamStr(0);
tekst := tekst+crlf;
if SpecialVersionSted = '' then
begin
tekst := tekst+crlf+crlf+'Scanningssted: '+StringReplace(Stednavn, ':', '', [rfReplaceAll, rfIgnoreCase])+' ('+Sted+')';
end;
if SpecialVersionSted <> '' then
begin
if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
begin
if Stednavn = '' then
begin
tekst := tekst+crlf+crlf+'Speciel version til: '+BladhusStedNavn[BladhusSted]+' ('+BladhusStedKode[BladhusSted]+')';
end
else
begin
tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+Sted+')';
end;
end
else
begin
tekst := tekst+crlf+crlf+'Speciel version til: '+split(Titel, ':', 2)+' ('+SpecialVersionSted+')';
end;
end;
if (Pos('omdeling.info',Url) = 0) then
begin
tekst := tekst+crlf+crlf;
tekst := tekst+crlf+crlf+' ********** DETTE ER KUN EN TEST VERSION **********';
tekst := tekst+crlf+crlf;
tekst := tekst+crlf+crlf+'Url: '+url;
end;
MessageBox(Handle, PWideChar(tekst), 'Information', MB_OK);
end;
procedure TMainForm.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
ListBox1MaxLinLgd,i : Integer;
myColor: TColor;
myBrush: TBrush;
begin
ListBox1MaxLinLgd := 0;
myBrush := TBrush.Create;
with (Control as TListBox).Canvas do
begin
if not Odd(Index) then
myColor := clWhite
else
myColor := clSilver;
if odSelected in State then
begin
myColor := MainForm.Color;
font.Color := clBlack;
end;
myBrush.Style := bsSolid;
myBrush.Color := myColor;
Windows.FillRect(handle, Rect, myBrush.Handle) ;
Brush.Style := bsClear;
TextOut(Rect.Left, Rect.Top,
(Control as TListBox).Items[Index]) ;
MyBrush.Free;
end;
for i := 0 to (ListBox1.Items.Count - 1) do
if (ListBox1.Canvas.TextWidth(ListBox1.Items[i]) > ListBox1MaxLinLgd) then
ListBox1MaxLinLgd := ListBox1.Canvas.TextWidth(ListBox1.Items[i]);
ListBox1.ScrollWidth := ListBox1MaxLinLgd;
end;
procedure TMainForm.Lukprogrammet1Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TMainForm.Manual1Click(Sender: TObject);
var
fileName : string;
begin
fileName := 'Docs\Manual_' + Scanningtype + '.pdf';
if FileExists(fileName) then
begin
if AdobeReaderExists then
begin
//ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
end
else
begin
ShowMessage('Acrobat Reader er ikke installeret!');
end;
end
else
begin
ShowMessage('Manualen : ' + #10#13 + fileName + #10#13 + 'blev ikke fundet!');
end;
end;
procedure TMainForm.Manualgenerel1Click(Sender: TObject);
var
fileName : string;
begin
fileName := 'Docs\Manual_0.pdf';
if FileExists(fileName) then
begin
if AdobeReaderExists then
begin
//ShellExecute(Handle, 'open', 'c:\Windows\notepad.exe', nil, nil, SW_SHOWNORMAL);
ShellExecute(Handle,'open',PChar(fileName), nil, nil, SW_SHOWNORMAL);
end
else
begin
ShowMessage('Acrobat Reader er ikke installeret!');
end;
end
else
begin
ShowMessage('Manualen : ' + #10#13 + fileName + #10#13 + 'blev ikke fundet!');
end;
end;
procedure TMainForm.Sprgefterboghandlernummer1Click(Sender: TObject);
begin
if Sprgefterboghandlernummer1.Checked then
begin
chkSporgEfterKunde.Checked := true;
end
else
begin
chkSporgEfterKunde.Checked := false;
end;
end;
procedure TMainForm.ReturpakkerfraDAO1Click(Sender: TObject);
begin
Scanningtype := '2';
NulstilAutomatiskValg();
InitReturFraDao();
end;
procedure TMainForm.Returpakkerfrapakkeshop1Click(Sender: TObject);
begin
Scanningtype := '6';
InitReturFraPakkeshop();
NulstilAutomatiskValg();
end;
procedure TMainForm.InitNatxpresslevering();
begin
AutomatiskTjekkodeStyring1.Enabled := true;
PakkeshopNulstil.Visible := false;
Pakkernormal1.Checked := true;
InitForm(FarveNormal,TitelNormal,UrlNormal);
PanelValg1.Color := clGreen;
PanelValg1.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := true;
Altidprintepakkelabel1.Enabled := true;
Altidprintepakkelabel1.Checked := false;
chkAltidPrintLabel.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Enabled := true;
Smpakker1.Enabled := false;
Storepakker1.Enabled := false;
radioStorPakke.Enabled := false;
radioLillePakke.Enabled := false;
ListBox1.Visible := true;
OpdaterListenButton01.Enabled := true;
EKLoverforsel.Enabled := true;
InitLillePakke();
ListBox1.Items.Clear;
if BladhusSted = 0 then
begin
IndlesScanningLogFil();
IndlesManglendeScanninger();
end;
end;
procedure TMainForm.InitReturFraDao();
begin
AutomatiskTjekkodeStyring1.Enabled := false;
ReturpakkerfraDAO1.Checked := true;
PakkeshopNulstil.Visible := false;
InitForm(FarveReturDAO,TitelReturDAO,UrlReturDAO);
PanelValg2.Color := clGreen;
PanelValg2.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := false;
Altidprintepakkelabel1.Enabled := false;
Altidprintepakkelabel1.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Enabled := false;
Smpakker1.Enabled := true;
Storepakker1.Enabled := true;
radioStorPakke.Enabled := true;
radioLillePakke.Enabled := true;
ListBox1.Visible := true;
ListBox1.Items.Clear;
ListBox2.Items.Clear;
EKLoverforsel.Enabled := false;
InitLillePakke();
end;
procedure TMainForm.InitReturFraKunde();
begin
AutomatiskTjekkodeStyring1.Enabled := false;
Returpakkerfraboghandler1.Checked := true;
PakkeshopNulstil.Visible := false;
InitForm(FarveReturBoghandler,TitelReturBoghandler,UrlReturBoghandler);
PanelValg3.Color := clGreen;
PanelValg3.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := false;
Altidprintepakkelabel1.Enabled := false;
Altidprintepakkelabel1.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Enabled := false;
Smpakker1.Enabled := true;
Storepakker1.Enabled := true;
radioStorPakke.Enabled := true;
radioLillePakke.Enabled := true;
ListBox1.Visible := true;
ListBox1.Items.Clear;
ListBox2.Items.Clear;
EKLoverforsel.Enabled := false;
InitLillePakke();
end;
procedure TMainForm.InitDirektelevering();
begin
AutomatiskTjekkodeStyring1.Enabled := false;
Budlevering1.Checked := true;
PakkeshopNulstil.Visible := false;
InitForm(FarveBudlevering,TitelBudlevering,UrlBudlevering);
PanelValg4.Color := clGreen;
PanelValg4.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := false;
Altidprintepakkelabel1.Enabled := false;
Altidprintepakkelabel1.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Enabled := false;
Smpakker1.Enabled := true;
Storepakker1.Enabled := true;
radioStorPakke.Enabled := true;
radioLillePakke.Enabled := true;
ListBox1.Visible := true;
ListBox1.Items.Clear;
DownloadButton01.Enabled := false;
OpdaterListenButton01.Enabled := true;
DownloadButton03.Visible := false;
EKLoverforsel.Enabled := false;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
if (BladhusSted = 0) or (BladhusSted = 2) or (BladhusSted = 3) then
begin
IndlesScanningLogFil();
IndlesManglendeScanninger();
end;
end;
procedure TMainForm.InitPakkeshoplevering();
begin
AutomatiskTjekkodeStyring1.Enabled := true;
Pakkeshoplevering1.Checked := true;
PakkeshopNulstil.Visible := false;
InitForm(FarvePakkeshoplevering,TitelPakkeshoplevering,UrlPakkeshoplevering);
PanelValg5.Color := clGreen;
PanelValg5.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := false;
Altidprintepakkelabel1.Enabled := false;
Altidprintepakkelabel1.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Enabled := false;
Smpakker1.Enabled := false;
Storepakker1.Enabled := false;
radioStorPakke.Enabled := false;
radioLillePakke.Enabled := false;
ListBox1.Visible := true;
ListBox1.Items.Clear;
DownloadButton01.Enabled := false;
OpdaterListenButton01.Enabled := true;
EKLoverforsel.Enabled := true;
InitLillePakke();
IndlesScanningLogFil();
if BladhusSted = 0 then
begin
IndlesManglendeScanninger();
end;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
end;
procedure TMainForm.InitReturFraPakkeshop();
begin
AutomatiskTjekkodeStyring1.Enabled := false;
Returpakkerfrapakkeshop1.Checked := true;
PakkeshopNulstil.Visible := false;
InitForm(FarveReturPakkeshop,TitelReturPakkeshop,UrlReturPakkeshop);
PanelValg6.Color := clGreen;
PanelValg6.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := false;
Altidprintepakkelabel1.Enabled := false;
Altidprintepakkelabel1.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
chkSporgEfterKunde.Checked := false;
Sprgefterboghandlernummer1.Enabled := false;
Smpakker1.Enabled := false;
Storepakker1.Enabled := false;
radioStorPakke.Enabled := false;
radioLillePakke.Enabled := false;
ListBox1.Visible := true;
ListBox1.Items.Clear;
DownloadButton01.Enabled := false;
OpdaterListenButton01.Enabled := true;
EKLoverforsel.Enabled := false;
InitLillePakke();
IndlesScanningLogFil();
if BladhusSted = 0 then
begin
IndlesManglendeScanninger();
end;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
end;
procedure TMainForm.Returpakkerfraboghandler1Click(Sender: TObject);
begin
Scanningtype := '3';
NulstilAutomatiskValg();
InitReturFraKunde();
end;
procedure TMainForm.InitIndleveringskode();
begin
AutomatiskTjekkodeStyring1.Enabled := false;
Returpakkerfrapakkeshop1.Checked := true;
PakkeshopNulstil.Visible := false;
InitForm(FarveIndlevering, TitelIndlevering, UrlReturPakkeshop);
PanelValg7.Color := clGreen;
PanelValg7.Font.Color := clWhite;
chkAltidPrintLabel.Enabled := false;
Altidprintepakkelabel1.Enabled := false;
Altidprintepakkelabel1.Checked := false;
Sprgefterboghandlernummer1.Checked := false;
Sprgefterboghandlernummer1.Enabled := false;
chkSporgEfterKunde.Checked := false;
Smpakker1.Enabled := false;
Storepakker1.Enabled := false;
radioStorPakke.Enabled := false;
radioLillePakke.Enabled := false;
ListBox1.Visible := true;
ListBox1.Items.Clear();
DownloadButton01.Enabled := false;
OpdaterListenButton01.Enabled := true;
EKLoverforsel.Enabled := false;
InitLillePakke();
IndlesScanningLogFil();
if BladhusSted = 0 then
begin
IndlesManglendeScanninger();
end;
IdFTP1.Passive := true;
IdFTP1.PassiveUseControlHost := true;
end;
procedure TMainForm.Storepakker1Click(Sender: TObject);
begin
InitStorPakke();
end;
procedure TMainForm.Smpakker1Click(Sender: TObject);
begin
InitLillePakke();
end;
procedure TMainForm.InitLillePakke();
begin
radioLillePakke.Checked := true;
Smpakker1.Checked := true;
// Stregkode := '';
end;
procedure TMainForm.InitStorPakke();
begin
radioStorPakke.Checked := true;
Storepakker1.Checked := true;
// 20150310: start
// Stregkode := '';
// 20150310: slut
end;
///
/// This function reads the file resource of "FileName" and returns
/// the version number as formatted text.
///
/// Sto_GetFmtFileVersion() = '4.13.128.0'
/// Sto_GetFmtFileVersion('', '%.2d-%.2d-%.2d') = '04-13-128'
///
/// If "Fmt" is invalid, the function may raise an
/// EConvertError exception.
/// Full path to exe or dll. If an empty
/// string is passed, the function uses the filename of the
/// running exe or dll.
/// Format string, you can use at most four integer
/// values.
/// Formatted version number of file, '' if no version
/// resource found.
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]]);
// 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;
procedure TMainForm.PlaySound(filename : PWideChar);
begin
if (filename <> '') then
begin
sndPlaySound(filename,
SND_NODEFAULT Or SND_ASYNC);
end;
end;
procedure TMainForm.Testlyd1Click(Sender: TObject);
begin
if AlarmLyd <> '' then
begin
PlaySound(PWideChar(AlarmLyd));
end
else
begin
MessageBox(Handle, PWideChar('Lyd fil ikke fundet (alarm)'), 'Information', MB_OK);
end;
end;
procedure TMainForm.Testlyd2Click(Sender: TObject);
begin
if (PakkeshopText1.Caption = 'Tjekkode') then
begin
if ScannetOkTilTjekkodeLyd <> '' then
begin
PlaySound(PWideChar(ScannetOkTilTjekkodeLyd));
end
else
begin
MessageBox(Handle, PWideChar('Lyd fil ikke fundet (ScannetOkTilTjekkodeLyd)'), 'Information', MB_OK);
end;
exit;
end;
if Smpakker1.Checked then
if ScannetOkLyd <> '' then
begin
PlaySound(PWideChar(ScannetOkLyd));
end
else
begin
MessageBox(Handle, PWideChar('Lyd fil ikke fundet (ScannetOkLyd)'), 'Information', MB_OK);
end;
if Storepakker1.Checked then
if ScannetOkStorLyd <> '' then
begin
PlaySound(PWideChar(ScannetOkStorLyd));
end
else
begin
MessageBox(Handle, PWideChar('Lyd fil ikke fundet (ScannetOkStorLyd)'), 'Information', MB_OK);
end;
end;
procedure TMainForm.Budlevering1Click(Sender: TObject);
begin
Scanningtype := '4';
NulstilAutomatiskValg();
InitDirektelevering();
end;
procedure TMainForm.Button1Click(Sender: TObject);
begin;
CheckCode();
end;
procedure TMainForm.EKLoverforselClick(Sender: TObject);
var
WebSvar : String;
URLStr : String;
StedKode : String;
Node: IXMLNode;
I: Integer;
status, kommentar : String;
begin
EKLoverforsel.Enabled := false;
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Overfører de scannede pakker til EKL');
logTekst := 'Overfører de scannede pakker til EKL';
SkrivScanningLogFil(logTekst);
StedKode := Sted;
URLStr := Format(UrlEKLoverforsel,[StedKode,Sted]);
// 20150330: start
if PanelValg5.Color = clGreen then
begin
URLStr := Format(UrlEKLoverforselPakkeshop,[StedKode,Sted]);
end;
// 20150330: slut
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
WebSvar := IdHTTP1.Get(URLStr);
except
on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
WebSvar := IdHTTP1.Get(URLStr);
end;
on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Fejl i web forespørgsel: '+e.Message);
logTekst := 'Fejl i web forespørgsel: '+e.Message;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i web forespørgsel: %s',[e.Message]);
end;
end;
try
XMLDocument1.LoadFromXML(WebSvar);
for I:= 0 to XMLDocument1.DocumentElement.ChildNodes.Count - 1 do begin
Node:= XMLDocument1.DocumentElement.ChildNodes[I];
if Node.NodeType = ntElement then begin
if Node.NodeName = 'Status' then begin
if not VarIsNull(Node.NodeValue) then
status := Node.NodeValue;
end;
if Node.NodeName = 'Kommentar' then begin
if not VarIsNull(Node.NodeValue) then
kommentar := Node.NodeValue;
end;
end;
end;
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Overførsel til EKL: ' + status+' '+kommentar);
logTekst := 'Overførsel til EKL: ' + status;
SkrivScanningLogFil(logTekst);
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Overførsel til EKL: ' + status);
logTekst := 'Overførsel til EKL: ' + status;
SkrivScanningLogFil(logTekst);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Fejl i XML-format: '+e.Message);
logTekst := 'Fejl i XML-format: '+e.Message;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i XML-format: %s',[e.Message]);
end;
end;
EKLoverforsel.Enabled := true;
ListBox1.SetFocus; // for at flytte fokus væk fra knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
// Hvis der var fejl i overførslen skal dette fejlmeldes her
if status = 'Fejl' then
begin // Her skal komme en alarm og rød skærm
PlaySound(PWideChar(AlarmLyd));
MainForm.Color := clRed;
RutenummerST.Caption := 'EKL overførsel';
BoghandlerNavnST.Caption := 'Fejl:';
if (pos('Deadlock', Kommentar) > 0) then
begin
RutenummerST.Caption := 'EKL overførsel fejlet';
BoghandlerNavnST.Caption := 'Prøv venligst igen om lidt...';
end;
KommentarST.Caption := Kommentar;
PakkeshopNulstil.Visible := true;
end;
end;
procedure TMainForm.CheckCode();
var
Barcode, Svar : String;
ClickedOK : Boolean;
begin
ClickedOK := InputQuery('Barcode check', 'Indtast stregkode', Barcode);
if ClickedOk then
begin
{ if (BarCodeValid(Barcode)) then
MessageBox(Handle, 'ok', 'Stregkode', MB_OK)
else
MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
}
// MessageBox(Handle, PAnsiChar(CheckSumModulo10(Barcode)), 'Stregkode', MB_OK);
{ if (CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1)) = Barcode) then
MessageBox(Handle, 'ok', 'Stregkode', MB_OK)
else
MessageBox(Handle, 'fejl', 'Stregkode', MB_OK);
}
Svar := 'Beregnet: '+CheckSumModulo10(LeftStr(Barcode,Length(Barcode)-1))+', Indtastet: '+Barcode;
MessageBox(Handle, PWideChar(Svar), 'Stregkode', MB_OK);
CheckCode();
end;
end;
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;
//
// Bladhus ***
//
procedure TMainForm.DownloadBladhusRuteskiftfil();
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
filnavn_input : string;
filnavn_output : string;
buttonSelected : Integer;
begin
filnavn_input := BladhusRuteskiftfil_server; // hvis filen ikke findes vises 'no such file or directory'
filnavn_output := BladhusRuteskiftfil_lokal;
case BladhusSted of
00 : begin;
end;
01 : begin;
buttonSelected := MessageDlg('Henter ruteskift filen ' + filnavn_input + ' fra DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Henter ' + filnavn_input + ' fra DAO ftp serveren.');
logTekst := 'Henter ' + filnavn_input + ' fra DAO ftp serveren.';
SkrivScanningLogFil(logTekst);
try
try
IdFTP1.host:='ftp.daoas.dk'; // hvis forkert vises 'socket error # 11001 host not found'
IdFTP1.Username:='nordjyske'; // hvis forkert vises 'login incorrect'
IdFTP1.Password:='kew3ma9u'; // hvis forkert vises 'login incorrect'
IdFTP1.Connect;
//IdFTP1.TransferType := ftASCII;
// IdFTP1.Get(filnavn_input, filnavn_output, True, False);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
except on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
end;
end;
// hvis 3. parameter er false (filen må ikke overskrives) vises 'Destination file already exists' hvis filen findes på disken
ListBox1.Items.Insert(0,TimeToStr(now) + ': Ruteskift fil gemt lokalt som ' + filnavn_output + '.');
logTekst := 'Ruteskift fil gemt lokalt som ' + filnavn_output + '.';
SkrivScanningLogFil(logTekst);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Ruteskift fil tjekkes.');
logTekst := 'Ruteskift fil tjekkes.';
SkrivScanningLogFil(logTekst);
finally
IdFTP1.Disconnect;
end;
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username);
logTekst := 'Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i FTP handling:'+ CrLf + '%s',
[e.Message
+ CrLf + 'Host: '+IdFTP1.host
+ CrLf + 'Username: '+IdFTP1.Username
]
);
end;
end;
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Download af ruteskiftfil annulleret.');
logTekst := 'Download af ruteskiftfil annulleret';
SkrivScanningLogFil(logTekst);
end;
IndlesRuteskiftFil(filnavn_output);
end;
02 : begin;
end;
03 : begin;
buttonSelected := MessageDlg('Henter ruteskift filen ' + filnavn_input + ' fra DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Henter ' + filnavn_input + ' fra DAO ftp serveren.');
logTekst := 'Henter ' + filnavn_input + ' fra DAO ftp serveren.';
SkrivScanningLogFil(logTekst);
try
try
IdFTP1.host:='ftp.daoas.dk'; // hvis forkert vises 'socket error # 11001 host not found'
IdFTP1.Username:='fd'; // hvis forkert vises 'login incorrect'
IdFTP1.Password:='pu4aphedre'; // hvis forkert vises 'login incorrect'
IdFTP1.Connect;
//IdFTP1.TransferType := ftASCII;
// IdFTP1.Get(filnavn_input, filnavn_output, True, False);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
except on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
end;
end;
// hvis 3. parameter er false (filen må ikke overskrives) vises 'Destination file already exists' hvis filen findes på disken
ListBox1.Items.Insert(0,TimeToStr(now) + ': Rute ruteskift fil gemt lokalt som ' + filnavn_output + '.');
logTekst := 'Ruteskift fil gemt lokalt som ' + filnavn_output + '.';
SkrivScanningLogFil(logTekst);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Ruteskift fil tjekkes.');
logTekst := 'Ruteskift fil tjekkes.';
SkrivScanningLogFil(logTekst);
finally
IdFTP1.Disconnect;
end;
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username);
logTekst := 'Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i FTP handling:'+ CrLf + '%s',
[e.Message
+ CrLf + 'Host: '+IdFTP1.host
+ CrLf + 'Username: '+IdFTP1.Username
]
);
end;
end;
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Download af ruteskiftfil annulleret.');
logTekst := 'Download af ruteskiftfil annulleret';
SkrivScanningLogFil(logTekst);
end;
IndlesRuteskiftFil(filnavn_output);
end;
04 : begin;
end;
else
ShowMessage('Ukendt Bladhus sted: ' + IntToStr(BladhusSted));
end;
end;
procedure TMainForm.DownloadBladhusKontrolfil();
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
filnavn_input : string;
filnavn_output : string;
buttonSelected : Integer;
begin
filnavn_input := BladhusKontrolfil_server; // hvis filen ikke findes vises 'no such file or directory'
filnavn_output := BladhusKontrolfil_lokal;
case BladhusSted of
01 :
begin;
buttonSelected := MessageDlg('Henter rute kontrol filen ' + filnavn_input + ' fra DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Henter ' + filnavn_input + ' fra DAO ftp serveren.');
logTekst := 'Henter ' + filnavn_input + ' fra DAO ftp serveren.';
SkrivScanningLogFil(logTekst);
try
try
IdFTP1.host:='ftp.daoas.dk'; // hvis forkert vises 'socket error # 11001 host not found'
IdFTP1.Username:='nordjyske'; // hvis forkert vises 'login incorrect'
IdFTP1.Password:='kew3ma9u'; // hvis forkert vises 'login incorrect'
IdFTP1.Connect;
//IdFTP1.TransferType := ftASCII;
// IdFTP1.Get(filnavn_input, filnavn_output, True, False);
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
except on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
end;
end;
// hvis 3. parameter er false (filen må ikke overskrives) vises 'Destination file already exists' hvis filen findes på disken
ListBox1.Items.Insert(0,TimeToStr(now) + ': Rute kontrol fil gemt lokalt som ' + filnavn_output + '.');
logTekst := 'Rute kontrol fil gemt lokalt som ' + filnavn_output + '.';
SkrivScanningLogFil(logTekst);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Rute kontrol fil tjekkes.');
logTekst := 'Rute kontrol fil tjekkes.';
SkrivScanningLogFil(logTekst);
finally
IdFTP1.Disconnect;
end;
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username);
logTekst := 'Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i FTP handling:'+ CrLf + '%s',
[e.Message
+ CrLf + 'Host: '+IdFTP1.host
+ CrLf + 'Username: '+IdFTP1.Username
]
);
end;
end;
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Download af kontrolfil annulleret.');
logTekst := 'Download af kontrolfil annulleret';
SkrivScanningLogFil(logTekst);
end;
IndlesKontrolFil(filnavn_output);
end;
02 : begin;
end;
03 : begin;
buttonSelected := MessageDlg('Henter rute kontrol filen ' + filnavn_input + ' fra DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Henter ' + filnavn_input + ' fra DAO ftp serveren.');
logTekst := 'Henter ' + filnavn_input + ' fra DAO ftp serveren.';
SkrivScanningLogFil(logTekst);
try
try
IdFTP1.host:='ftp.daoas.dk'; // hvis forkert vises 'socket error # 11001 host not found'
IdFTP1.Username:='fd'; // hvis forkert vises 'login incorrect'
IdFTP1.Password:='pu4aphedre'; // hvis forkert vises 'login incorrect'
IdFTP1.Connect;
//IdFTP1.TransferType := ftASCII;
IdFTP1.Get(filnavn_input, filnavn_output, True, False);
// hvis 3. parameter er false (filen må ikke overskrives) vises 'Destination file already exists' hvis filen findes på disken
ListBox1.Items.Insert(0,TimeToStr(now) + ': Rute kontrol fil gemt lokalt som ' + filnavn_output + '.');
logTekst := 'Rute kontrol fil gemt lokalt som ' + filnavn_output + '.';
SkrivScanningLogFil(logTekst);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Rute kontrol fil tjekkes.');
logTekst := 'Rute kontrol fil tjekkes.';
SkrivScanningLogFil(logTekst);
finally
IdFTP1.Disconnect;
end;
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username);
logTekst := 'Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i FTP handling:'+ CrLf + '%s',
[e.Message
+ CrLf + 'Host: '+IdFTP1.host
+ CrLf + 'Username: '+IdFTP1.Username
]
);
end;
end;
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Download af kontrolfil annulleret.');
logTekst := 'Download af kontrolfil annulleret';
SkrivScanningLogFil(logTekst);
end;
IndlesKontrolFil(filnavn_output);
end;
04 : begin;
end;
else
ShowMessage('Ukendt Bladhus sted ???') ;
end;
end;
procedure TMainForm.SendFilTilDAO(fil_type, filnavn_input, filnavn_output: String);
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
testsystem : String;
begin
testsystem := '';
if (Pos('omdeling.info',Url) = 0) then
begin
testsystem := 'TEST_';
end;
filnavn_output := testsystem + filnavn_output;
ListBox1.Items.Insert(0,TimeToStr(now) + ': Sender ' + filnavn_input + ' til DAO ftp serveren.');
logTekst := 'Sender ' + filnavn_input + ' til DAO ftp serveren.';
SkrivScanningLogFil(logTekst);
try
try
IdFTP1.host:='ftp.daoas.dk'; // hvis forkert vises 'socket error # 11001 host not found'
IdFTP1.Username:='scannerprogram'; // hvis forkert vises 'login incorrect'
IdFTP1.Password:='DaoScan2015'; // hvis forkert vises 'login incorrect'
IdFTP1.Connect;
//IdFTP1.TransferType := ftASCII;
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
IdFTP1.ChangeDir('fraScannerprogram');
IdFTP1.Put(filnavn_input, filnavn_output, True);
except on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
IdFTP1.Put(filnavn_input, filnavn_output, True);
end;
end;
// hvis 3. parameter er false (filen må ikke overskrives) vises 'Destination file already exists' hvis filen findes på disken
logTekst := fil_type + ' fil sendt til DAO som ' + filnavn_output + '.';
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
SkrivScanningLogFil(logTekst);
finally
IdFTP1.Disconnect;
end;
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username);
logTekst := 'Fejl i FTP handling: ' + e.Message + ' Host: '+IdFTP1.host + ' Username: '+IdFTP1.Username;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i FTP handling:'+ CrLf + '%s',
[e.Message
+ CrLf + 'Host: '+IdFTP1.host
+ CrLf + 'Username: '+IdFTP1.Username
]
);
end;
end;
end;
procedure TMainForm.UploadLogfilTilDAO();
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
idag, imorgen : TDateTime;
imorgenYmd : string;
logFilnavn : string;
filnavn_input : string;
filnavn_output : string;
buttonSelected : Integer;
openDialog : TOpenDialog;
begin
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('_yyyymmdd',imorgen);
logFilnavn := 'Logs/' + 'Scanning' + imorgenYmd + '.log';
filnavn_input := logFilnavn; // hvis filen ikke findes vises 'no such file or directory'
filnavn_output := Sted + '_Scanning' + imorgenYmd + '_' + FormatDateTime('hhmmss',idag) + '.log';
buttonSelected := MessageDlg('Sender den aktuelle log fil (' + filnavn_input + ') til DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
SendFilTilDao('Log', filnavn_input, filnavn_output);
end
else
begin
buttonSelected := MessageDlg('Vil du sende en anden logfil til DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
// Create the open dialog object - assign to our open dialog variable
openDialog := TOpenDialog.Create(self);
// Set up the starting directory to be the current one
openDialog.InitialDir := GetCurrentDir + '\Logs';
// Only allow existing files to be selected
openDialog.Options := [ofFileMustExist];
// Allow only .log files to be selected
openDialog.Filter := 'Log filer|*.log';
// Display the open file dialog
if openDialog.Execute then
begin
filnavn_input := openDialog.FileName; // hvis filen ikke findes vises 'no such file or directory'
filnavn_output := Sted + '_Scanning' + imorgenYmd + '_' + FormatDateTime('hhmmss',idag) + '.log';
SendFilTilDao('Log', filnavn_input, filnavn_output);
end
else
begin
logTekst := 'Upload af log fil annulleret';
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
SkrivScanningLogFil(logTekst);
end;
// Free up the dialog
openDialog.Free;
end
else
begin
logTekst := 'Upload af log fil annulleret';
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
SkrivScanningLogFil(logTekst);
end;
end;
end;
procedure TMainForm.UploadInifilTilDAO();
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
var
idag, imorgen : TDateTime;
imorgenYmd : string;
iniFilnavn : string;
filnavn_input : string;
filnavn_output : string;
buttonSelected : Integer;
begin
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('_yyyymmdd',imorgen);
iniFilnavn := ChangeFileExt(ExtractFileName(ExtractFileName(ParamStr(0))), '.ini');
filnavn_input := iniFilnavn; // hvis filen ikke findes vises 'no such file or directory'
filnavn_output := Sted + '_Scanning' + imorgenYmd + '_' + FormatDateTime('hhmmss',idag) + '.ini';
buttonSelected := MessageDlg('Sender ini filen ' + filnavn_input + ' til DAO ftp server',mtConfirmation, mbOKCancel, 0);
if buttonSelected = mrOK then
begin
SendFilTilDao('Ini', filnavn_input, filnavn_output);
end
else
begin
logTekst := 'Upload af ini fil annulleret';
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
SkrivScanningLogFil(logTekst);
end;
end;
procedure TMainForm.Uploadlogfil1Click(Sender: TObject);
begin
UploadLogfilTilDAO();
UploadInifilTilDAO();
ListBox1.SetFocus; // for at flytte fokus væk fra upload knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
end;
procedure TMainForm.DownloadButton01Click(Sender: TObject);
begin
DownloadBladhusKontrolfil();
ListBox1.SetFocus; // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
end;
procedure TMainForm.OpdaterListenButton01Click(Sender: TObject);
const
crlf = Chr(13) + Chr(10) ; // Carriage return & Linefeed
begin
IndlesManglendeScanninger();
ListBox1.SetFocus; // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
end;
procedure TMainForm.DownloadButton03Click(Sender: TObject);
begin
if (getProddag() = 'lørdag') then
begin
DownloadBladhusRuteskiftfil();
end;
ListBox1.SetFocus; // for at flytte fokus væk fra download knappen så denne ikke aktiveres ved scanning / indtastning af stregkode
end;
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;
procedure TMainForm.IndlesManglendeScanninger();
var
WebSvar : String;
URLStr : String;
StedKode : String;
Node: IXMLNode;
I: Integer;
stregkode, modtagernavn, modtageradresse, kommentar : string;
pakketype, tjekkodestatus : String;
pakketypeix, antalLiniefelter, antalFelterFundet, linienr : Integer;
pakketyper : TStrings;
antlin : Integer;
antlinIdag, antlinSenere : Integer;
XmlFelter : TStrings;
begin
XmlFelter := TStringList.Create;
pakketyper := TStringList.Create;
linienr := 0;
ListBox2.Clear;
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Henter oversigt over pakker der endnu ikke er modtaget');
logTekst := 'Henter oversigt over pakker der endnu ikke er modtaget';
SkrivScanningLogFil(logTekst);
if (BladhusSted > 00) and (BladhusSted < Length(BladhusStedNavn)) then
begin
StedKode := BladhusStedKode[BladhusSted];
end
else
begin
StedKode := Sted;
end;
if (Scanningtype = '6') then
begin
URLStr := Format(UrlPakkeshopManglendeReturScanninger,[StedKode]);
end
else if (Scanningtype = '5') then
begin
URLStr := Format(UrlPakkeshopManglendeScanninger,[StedKode]);
end
else if (Scanningtype = '1') then
begin
URLStr := Format(UrlManglendeScanninger,[StedKode,'B2']);
end
else if (Scanningtype = '4') then
begin
URLStr := Format(UrlManglendeScanninger,[StedKode,'A2']); // Budleveringer
end
else
begin
exit;
end;
// 20150310: slut
try
//raise EIdConnClosedGracefully.Create('test'); // KUN TIL TEST
// URLStr := string(Utf8Encode(URLStr));
WebSvar := IdHTTP1.Get(URLStr);
except
on e:EIdConnClosedGracefully do
begin
// Her skal vi ikke gøre noget - men vi skal forespørge igen
WebSvar := IdHTTP1.Get(URLStr);
end;
on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Fejl i web forespørgsel: '+e.Message);
logTekst := 'Fejl i web forespørgsel: '+e.Message;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i web forespørgsel: %s',[e.Message]);
end;
end;
try
XMLDocument1.LoadFromXML(WebSvar);
antlin := 0;
antlinIdag := 0;
antlinSenere := 0;
antalFelterFundet := 0;
for I:= 0 to XMLDocument1.DocumentElement.ChildNodes.Count - 1 do begin
Node:= XMLDocument1.DocumentElement.ChildNodes[I];
if Node.NodeType = ntElement then begin
if Node.NodeName = 'Stregkode' then
begin
antlin := antlin + 1;
// 20150306: start
if not VarIsNull(Node.NodeValue) then
begin
if (pos('(', Node.NodeValue) = 0) then
begin
antlinIdag := antlinIdag + 1;
end
else
begin
antlinSenere := antlinSenere + 1;
end;
end;
// 20150306: slut
end;
end;
if (XmlFelter.values[Node.NodeName] <> '') then
XmlFelter.values[Node.NodeName] := IntToStr(StrToInt(XmlFelter.values[Node.NodeName]) + 1)
else
XmlFelter.values[Node.NodeName] := '1';
end;
antalLiniefelter := XmlFelter.Count;
antalFelterFundet := 0;
SetLength(stregkoderMedTjekkodeArray, 0); // reset fra tidligere brug
SetLength(stregkoderMedTjekkodeArray, antlin); // sæt antal elementer i array
logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';
if (antlinSenere > 0) then
begin
logTekst := logTekst + ' (' + IntToStr(antlinIdag) + ' til i dag og ' + IntToStr(antlinSenere) + ' til senere)';
end;
logTekst := logTekst + '.';
SkrivScanningLogFil(logTekst);
for I:= 0 to XMLDocument1.DocumentElement.ChildNodes.Count - 1 do begin
Node:= XMLDocument1.DocumentElement.ChildNodes[I];
if Node.NodeType = ntElement then begin
if Node.NodeName = 'Stregkode' then begin
if not VarIsNull(Node.NodeValue) then
stregkode := Node.NodeValue;
antalFelterFundet := antalFelterFundet + 1;
end;
if Node.NodeName = 'ModtagerNavn' then begin
if not VarIsNull(Node.NodeValue) then
modtagernavn := Node.NodeValue;
antalFelterFundet := antalFelterFundet + 1;
end;
if Node.NodeName = 'ModtagerAdresse' then begin
if not VarIsNull(Node.NodeValue) then
modtageradresse := Node.NodeValue;
antalFelterFundet := antalFelterFundet + 1;
end;
if Node.NodeName = 'Kommentar' then begin
if not VarIsNull(Node.NodeValue) then
kommentar := Node.NodeValue;
antalFelterFundet := antalFelterFundet + 1;
end;
if Node.NodeName = 'PakkeType' then begin
if not VarIsNull(Node.NodeValue) then
pakketype := Node.NodeValue;
antalFelterFundet := antalFelterFundet + 1;
if (pakketyper.values[pakketype] <> '') then
pakketyper.values[pakketype] := IntToStr(StrToInt(pakketyper.values[pakketype]) + 1)
else
pakketyper.values[pakketype] := '1';
end;
if Node.NodeName = 'TjekkodeStatus' then begin
if not VarIsNull(Node.NodeValue) then
tjekkodestatus := Node.NodeValue;
antalFelterFundet := antalFelterFundet + 1;
if (tjekkodestatus = '-1') then
begin
// 20150306: start
// stregkoderMedTjekkodeArray[linienr] := stregkode;
if (pos(' ', stregkode) > 0) then
begin
stregkoderMedTjekkodeArray[linienr] := split(stregkode, ' ', 2); // Fjerner lige en evt. fremtidig dato fra feltet
end
else
begin
stregkoderMedTjekkodeArray[linienr] := stregkode;
end;
linienr := linienr + 1;
end;
end;
if antalFelterFundet = antalLiniefelter then
begin
if (ScanningType = '1') then
ListBox2.Items.Add(pakketype+'; '+stregkode+'; '+modtagernavn+'; '+modtageradresse+'; '+kommentar+'; '+tjekkodestatus)
else if (ScanningType = '4') then
ListBox2.Items.Add(pakketype+'; '+stregkode+'; '+modtagernavn+'; '+modtageradresse+'; '+kommentar)
else if (ScanningType = '5') then
ListBox2.Items.Add(stregkode+'; '+modtagernavn+'; '+modtageradresse+'; '+kommentar+'; '+tjekkodestatus)
else
ListBox2.Items.Add(stregkode+'; '+modtagernavn+'; '+modtageradresse+'; '+kommentar);
antalFelterFundet := 0;
tjekkodestatus := '';
end;
end;
end;
for pakketypeix := 0 to pakketyper.Count-1 do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + ' '+pakketyper[pakketypeix]+' pakke(r) ikke modtaget');
end;
// Free up the list object
pakketyper.Free;
// ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Der er '+IntToStr(antlin)+' pakker, der endnu ikke er modtaget.');
logTekst := 'Der er ' + IntToStr(antlin) + ' pakker, der endnu ikke er modtaget';
if (antlinSenere > 0) then
begin
logTekst := logTekst + ' (' + IntToStr(antlinIdag) + ' til i dag og ' + IntToStr(antlinSenere) + ' til senere)';
end;
logTekst := logTekst + '.';
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logTekst);
if (antlinSenere > 0) then
begin
StaticTextManglendePakker.Caption := IntToStr(antlinIdag) + '/' + IntToStr(antlinSenere);
end
else
begin
StaticTextManglendePakker.Caption := IntToStr(antlinIdag);
end;
if (Scanningtype = '1') then
begin
//antlinIdag := 9876; // til test af boksens udseende ved stort tal
PanelManglendePakker1.Caption := IntToStr(antlinIdag + antlinSenere);
if (antlinIdag + antlinSenere > 0) then
begin
PanelManglendePakker1.Visible := true;
end
else
begin
PanelManglendePakker1.Visible := false;
end;
end;
if (Scanningtype = '2') then
begin
PanelManglendePakker2.Caption := IntToStr(antlinIdag + antlinSenere);
if (antlinIdag + antlinSenere > 0) then
begin
PanelManglendePakker2.Visible := true;
end
else
begin
PanelManglendePakker2.Visible := false;
end;
end;
if (Scanningtype = '3') then
begin
PanelManglendePakker3.Caption := IntToStr(antlinIdag + antlinSenere);
if (antlinIdag + antlinSenere > 0) then
begin
PanelManglendePakker3.Visible := true;
end
else
begin
PanelManglendePakker3.Visible := false;
end;
end;
if (Scanningtype = '4') then
begin
PanelManglendePakker4.Caption := IntToStr(antlinIdag + antlinSenere);
if (antlinIdag + antlinSenere > 0) then
begin
PanelManglendePakker4.Visible := true;
end
else
begin
PanelManglendePakker4.Visible := false;
end;
end;
if (Scanningtype = '5') then
begin
PanelManglendePakker5.Caption := IntToStr(antlinIdag + antlinSenere);
if (antlinIdag + antlinSenere > 0) then
begin
PanelManglendePakker5.Visible := true;
end
else
begin
PanelManglendePakker5.Visible := false;
end;
end;
if (Scanningtype = '6') then
begin
PanelManglendePakker6.Caption := IntToStr(antlinIdag + antlinSenere);
if (antlinIdag + antlinSenere > 0) then
begin
PanelManglendePakker6.Visible := true;
end
else
begin
PanelManglendePakker6.Visible := false;
end;
end;
except on e:exception do
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Fejl i XML-format: '+e.Message);
logTekst := 'Fejl i XML-format: '+e.Message;
SkrivScanningLogFil(logTekst);
raise exception.CreateFmt('Fejl i XML-format: %s',[e.Message]);
end;
end;
end;
procedure TMainForm.IndlesScanningLogFil();
var
SomeTxtFile : TextFile;
buffer : string;
S: string;
idag, imorgen : TDateTime;
imorgenYmd : string;
logFilnavn : string;
begin
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('_yyyymmdd',imorgen);
logFilnavn := 'Logs/Scanning' + imorgenYmd + '.log';
if FileExists(logFilnavn) then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logFilnavn+' indlæses.');
logTekst := logFilnavn+' indlæses.';
SkrivScanningLogFil(logTekst);
AssignFile(SomeTxtFile, logFilnavn);
try
Reset(SomeTxtFile);
while not EOF(SomeTxtFile) do
begin
ReadLn(SomeTxtFile, buffer) ;
S := buffer;
ListBox1.Items.Insert(0, S);
end;
finally
CloseFile(SomeTxtFile);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + logFilnavn+' indlæst.');
ListBox1.Items.Insert(0,'');
ListBox1.Items.Insert(0,'');
ListBox1.Items.Insert(0,'');
ListBox1.Items.Insert(0,'');
ListBox1.Items.Insert(0,'');
ListBox1.Items.Insert(0,'');
end;
end;
end;
procedure TMainForm.SkrivScanningLogFil(var tekst : string);
var
SomeTxtFile : TextFile;
buffer : string;
S: string;
idag, imorgen : TDateTime;
imorgenYmd : string;
logFilnavn : string;
error : Integer;
begin
if (SkrivLog = '1') then
begin
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('_yyyymmdd',imorgen);
logFilnavn := 'Logs/' + 'Scanning' + imorgenYmd + '.log';
// Get the current directory
// dir := GetCurrentDir;
// ShowMessage('Current directory = '+dir);
// logFilnavn := dir + '\Logs\' + 'Scanning' + imorgenYmd + '.log';
// ShowMessage('logFilnavn = '+logFilnavn);
if not DirectoryExists('Logs') then
begin
CreateDir('Logs');
end;
AssignFile(SomeTxtFile, logFilnavn);
if FileExists(logFilnavn) then
begin
try
try
Append(SomeTxtFile);
WriteLn(SomeTxtFile, TimeToStr(now) + ': ' + tekst) ;
except on e:exception do
//ShowMessageFmt('File create failed with error %d',[error]);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + ' Kan ikke skrive til log filen...');
end;
finally
CloseFile(SomeTxtFile);
end;
end
else
begin
try
try
ReWrite(SomeTxtFile);
WriteLn(SomeTxtFile, TimeToStr(now) + ': ' + tekst) ;
except on e:exception do
// ShowMessageFmt('File create failed with error %d',[error]);
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + ' Kan ikke oprette/skrive til log filen...');
end;
finally
CloseFile(SomeTxtFile);
end;
end;
end;
end;
procedure TMainForm.IndlesRuteskiftFil(var filnavn : string);
var
SomeTxtFile : TextFile;
buffer : string;
linnr : integer;
S: string;
A: TStrArray;
idag, imorgen : TDateTime;
imorgenYmd : string;
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + filnavn+' indlæses.');
logTekst := filnavn+' indlæses.';
SkrivScanningLogFil(logTekst);
SetLength(ruteHverdagArray, 1);
SetLength(ruteLordagArray, 1);
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('yyyy-mm-dd',imorgen);
if FileExists(filnavn) then
begin
AssignFile(SomeTxtFile, filnavn);
linnr := 0;
try
Reset(SomeTxtFile);
while not EOF(SomeTxtFile) do
begin
ReadLn(SomeTxtFile, buffer) ;
S := buffer;
SetLength(A,0);
Explode(A, ';', S);
if (length(A) < 2) then
begin
Explode(A, ',', S);
end;
if (length(A) > 1) then
begin
SetLength(ruteHverdagArray, linnr+1);
SetLength(ruteLordagArray, linnr+1);
ruteHverdagArray[linnr] := A[0];
ruteLordagArray[linnr] := A[1];
linnr := linnr+1;
end;
end;
finally
//ShowMessage(IntToStr(length(A)));
CloseFile(SomeTxtFile);
//ShowMessage(IntToStr(length(ruteHverdagArray)));
if (linnr > 0) then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + IntToStr(linnr)+' linier indlæst til '+imorgenYmd+'.');
logTekst := IntToStr(linnr)+' linier indlæst til '+imorgenYmd+'.';
SkrivScanningLogFil(logTekst);
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' +'Fandt ingen linier til '+imorgenYmd+'.');
logTekst := 'Fandt ingen linier til '+imorgenYmd+'.';
SkrivScanningLogFil(logTekst);
PlaySound(PWideChar(AlarmLyd));
end;
end;
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Ruteskift fil '+filnavn+' findes ikke.');
logTekst := 'Ruteskift fil '+filnavn+' findes ikke.';
SkrivScanningLogFil(logTekst);
PlaySound(PWideChar(AlarmLyd));
end;
end;
procedure TMainForm.IndlesKontrolFil(var filnavn : string);
var
SomeTxtFile : TextFile;
buffer : string;
linnr : integer;
S: string;
A: TStrArray;
idag, imorgen : TDateTime;
imorgenYmd : string;
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + filnavn+' indlæses.');
logTekst := filnavn+' indlæses.';
SkrivScanningLogFil(logTekst);
SetLength(ruteArray, 1);
SetLength(korelisteArray, 1);
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('yyyy-mm-dd',imorgen);
if FileExists(filnavn) then
begin
AssignFile(SomeTxtFile, filnavn);
linnr := 0;
try
Reset(SomeTxtFile);
while not EOF(SomeTxtFile) do
begin
ReadLn(SomeTxtFile, buffer) ;
S := buffer;
SetLength(A,0);
Explode(A, ';', S);
if (length(A) < 3) then
begin
Explode(A, ',', S);
end;
if (A[0]=imorgenYmd) then
begin
if (length(A) > 2) then
begin
SetLength(ruteArray, linnr+1);
SetLength(korelisteArray, linnr+1);
ruteArray[linnr] := A[1];
korelisteArray[linnr] := A[2];
linnr := linnr+1;
end;
end;
end;
finally
//ShowMessage(IntToStr(length(A)));
CloseFile(SomeTxtFile);
//ShowMessage(IntToStr(length(ruteArray)));
if (linnr > 0) then
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + IntToStr(linnr)+' linier indlæst til '+imorgenYmd+'.');
logTekst := IntToStr(linnr)+' linier indlæst til '+imorgenYmd+'.';
SkrivScanningLogFil(logTekst);
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' +'Fandt ingen linier til '+imorgenYmd+'.');
logTekst := 'Fandt ingen linier til '+imorgenYmd+'.';
SkrivScanningLogFil(logTekst);
PlaySound(PWideChar(AlarmLyd));
end;
end;
end
else
begin
ListBox1.Items.Insert(0,TimeToStr(now) + ': ' + 'Kontrol fil '+filnavn+' findes ikke.');
logTekst := 'Kontrol fil '+filnavn+' findes ikke.';
SkrivScanningLogFil(logTekst);
PlaySound(PWideChar(AlarmLyd));
end;
end;
//
// Bladhus ***
//
function TMainForm.TjekKoreliste(var RuteNummer, Koreliste : string) : string;
var
i : Integer;
svar : String;
begin
//ShowMessage('Køreliste 1: '+korelisteArray[0]);
// ShowMessage('Kontrollerer rute ' + RuteNummer + ' og køreliste ' + Koreliste + ' i kontrolfilen');
// NB. Der er rod i begreberne RuteNummer og Koreliste - nogle steder er de byttet rundt!
//ShowMessage('Kontrollerer rute ' + Koreliste + ' og køreliste ' + RuteNummer + ' i kontrolfilen');
svar := 'Køreliste ikke i kontrolfil';
case BladhusSted of
01 :
begin;
for i := 0 to length(ruteArray)-1 do
begin
if (Koreliste=ruteArray[i]) then
begin
svar := korelisteArray[i]; // returnerer den forventede køreliste
end;
end;
end;
// 02 : begin;
//ShowMessage('02') ;
// end;
03 : begin;
for i := 0 to length(ruteArray)-1 do
begin
if (Koreliste=ruteArray[i]) then
begin
svar := korelisteArray[i]; // returnerer den forventede køreliste
end;
end;
end;
// 04 : begin;
//ShowMessage('04') ;
// end;
else
svar := RuteNummer; // Dette svarer til at køreliste er godkendt uden kontrol fil
end;
if (RuteNummer = 'Rutenr') then // fra printertest funktionen
svar := RuteNummer; // Dette svarer til at køreliste er godkendt uden kontrol fil
result := svar;
end;
procedure TMainForm.VisAlarmSkaerm(strMessage: string);
begin
//ShowMessage('Ændring ikke tilladt');
// Her skal komme en 'rød skærm' alarm
PlaySound(PWideChar(AlarmLyd));
ListBox1.Items.Insert(0, strMessage);
MainForm.Color := clRed;
RuteNummerST.Caption := '';
BoghandlerNavnST.Caption := '';
KommentarST.Caption := strMessage;
PakkeshopNulstil.Visible := true;
end;
function TMainForm.getProddato() : TDate;
var
idag, imorgen : TDateTime;
imorgenYmd : string;
begin
idag := Now;
imorgen := IncDay(idag, 1); //adds 1 day(s)
// Hvis vi er efter midnat og inden middag skal vi bruge dagsdato som imorgen
if (FormatDateTime('hh:nn',idag) < '12:00') then
begin
imorgen := idag;
end;
imorgenYmd := FormatDateTime('dd-mm-yyyy',imorgen);
result := StrToDateTime(imorgenYmd);
end;
function TMainForm.getProddag() : String;
begin
// ShowMessage(LongDayNames[DayOfWeek(getProddato())]);
result := FormatSettings.LongDayNames[DayOfWeek(getProddato())];
//result := 'lørdag'; // MENS VI TESTER kan vi fremtvinge lørdag situation her
end;
function TMainForm.retRutenummer(rutenummer : String) : String;
var
i : Integer;
svar : String;
begin
svar := rutenummer;
case BladhusSted of
01 :
begin;
//ShowMessage('01') ;
end;
// 02 : begin;
//ShowMessage('02') ;
// end;
03 : begin;
for i := 0 to length(ruteHverdagArray)-1 do
begin
if (rutenummer=ruteHverdagArray[i]) then
begin
svar := ruteLordagArray[i]; // returnerer den forventede lørdagsrute
end;
end;
end;
// 04 : begin;
//ShowMessage('04') ;
// end;
else
svar := rutenummer; // Dette svarer til at rute ikke skal ændres
end;
result := svar;
end;
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;
procedure TMainForm.Scanogstjekkoden1Click(Sender: TObject);
begin
if Scanogstjekkoden1.Checked then
begin
chkScanTjekkode.Checked := true;
end
else
begin
chkScanTjekkode.Checked := false;
end;
end;
function TMainForm.AdobeReaderExists: Boolean;
var
AReg: TRegistry;
begin
result:= false;
AReg := TRegistry.Create;
AReg.RootKey := HKEY_LOCAL_MACHINE;
if AReg.KeyExists('\SOFTWARE\Adobe\Acrobat Reader') then
result:= True;
AReg.Free;
end;
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
// tjektype = 'Opstart' skal vise alarmlinie, samt opdatere listbox1
// 'Test' skal vise alarmlinie, samt opdatere listbox1
// 'Timer' skal kun vise alarmlinie
if (PrinterNavn = 'Ingen') and ( (tjektype = 'Opstart') or (tjektype = 'Test') ) then
begin
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
begin
printerTxt := 'Der er ikke installeret en printer på denne PC';
ListBox1.Items.Insert(0,printerTxt);
SkrivScanningLogFil(printerTxt);
end
else
begin
hPrinter := GetCurrentPrinterHandle;
try
EnumJobs(hPrinter, 0, 1000, 1, nil, 0, bytesNeeded, numJobs);
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;
end;
end;
function TMainForm.CheckUrl(url:string):boolean;
var
hSession, hfile, hRequest: hInternet;
dwindex,dwcodelen :dword;
dwcode:array[1..20] of char;
res : pchar;
begin
if pos('http://',lowercase(url))=0 then
url := 'http://'+url;
Result := false;
hSession := InternetOpen('InetURL:/1.0',
INTERNET_OPEN_TYPE_PRECONFIG,
nil,
nil,
0);
if assigned(hsession) then
begin
hfile := InternetOpenUrl(hsession,
pchar(url),
nil,
0,
INTERNET_FLAG_RELOAD,
0);
dwIndex := 0;
dwCodeLen := 10;
HttpQueryInfo(hfile,
HTTP_QUERY_STATUS_CODE,
@dwcode,
dwcodeLen,
dwIndex);
res := pchar(@dwcode);
result:= (res ='200') or (res ='302');
if assigned(hfile) then
InternetCloseHandle(hfile);
InternetCloseHandle(hsession);
end;
end;
// 20150310: start
procedure TMainForm.RoundCornerOf(Control: TWinControl);
var
R: TRect;
Rgn: HRGN;
begin
with Control do
begin
R := ClientRect;
// rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 20, 20) ;
rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 25, 25) ;
// rgn := CreateRoundRectRgn(R.Left, R.Top, R.Right, R.Bottom, 30, 30) ;
Perform(EM_GETRECT, 0, lParam(@r)) ;
InflateRect(r, - 4, - 4) ;
Perform(EM_SETRECTNP, 0, lParam(@r)) ;
SetWindowRgn(Handle, rgn, True) ;
Invalidate;
end;
end;
// 20150310: slut
end.