Delphi-PRAXiS

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Anwendung in Dienst umwandeln (https://www.delphipraxis.net/183618-anwendung-dienst-umwandeln.html)

arizona88 23. Jan 2015 10:27
Anwendung in Dienst umwandeln
 
Hallo ich habe mein erstes Programm in Delphi geschrieben und wollte dies jetzt als Dienst laufen lassen.
Leider weiß ich nciht wie.

Kann mir einer sagen was ich alles umändern muss um dieses Programm als dienst laufen zulassen:thumb:

Delphi-Quellcode:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs,
  Variants, Forms, StdCtrls, Sockets, OverbyteIcsWndControl, OverbyteIcsWSocket,
  IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IDSocketHandle, IniFiles,
  ADODB, DB, Menus;

type
    TMADABarcode = class(TService);
    TForm1 = class(TForm)
    Memo1: TMemo;
    IdUDPServer1: TIdUDPServer;
    ADOConnection1: TADOConnection;
    Einfuegen: TADOQuery;
    Abfrage: TADODataSet;
    MainMenu1: TMainMenu;
    Datei1: TMenuItem;
    IPAdresseNquire1: TMenuItem;
    Beenden1: TMenuItem;

    procedure IdUDPServer1UDPRead(AThread: TIdUDPListenerThread; AData: TBytes;
      ABinding: TIdSocketHandle);
    procedure FormCreate(Sender: TObject);
    procedure IPAdresseNquire1Click(Sender: TObject);
    procedure IdUDPServer1AfterBind(Sender: TObject);


  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  type
  Tbuf = record
    case boolean of
      true : (ch : char);
      false : (b : byte);
    end;

var
  MADABarcode :TMADABarcode;
  Form1: TForm1;
  merker:Integer;
  Con, nquireIP, AktDate, KartenNr, dbTyp, serverip:String;
  procedure clearScreen();
  function chartobyte(ch : char) : byte;
  procedure sendeKey(Position:integer; s:String);
  procedure sendeDaten(Position:Integer; s:String);
  procedure Logbucheintrag(Typ: integer; Nachricht: string);
  function testImHaus(KartenNr:String):integer;
  procedure updateBesucherstatus(imHaus:String);
  procedure dbTypabfragen;
  procedure Besuchsvorgang_archivieren();
  function GetDateTimeString(dt:TDateTime):string;

implementation

uses Unit4;

{$R *.dfm}





function chartobyte(ch : char) : byte;
var buf : Tbuf;
begin
buf.ch := ch;
result := buf.b
end;

procedure TForm1.FormCreate(Sender: TObject);
var DelphiIni : TInIFile;
    Pfadname:shortString;
    Binding: TIdSocketHandle;
begin
     Pfadname := ParamStr(0);
     while(length(Pfadname)>0)and(Pfadname[length(Pfadname)]<>'\')do dec(Pfadname[0]);
     DelphiIni:= TIniFile.Create(Pfadname+'BM.ini');
     Con:=DelphiIni.ReadString('SYSTEM', 'DBCONNECTION', '');
     nquireIP:=DelphiIni.ReadString('Nquire', 'IP', '');
     serverip:=DelphiIni.ReadString('Nquire', 'Server-IP', '');
     if(length(nquireIP)=0)then begin
        showmessage('Bitte Ip-Adresse des NQuire Gerätes eintragen!');
        nquireIP:='192.168.0.221';
     end;
     Binding := idudpserver1.Bindings.add;
     Binding.IP:=serverip;
     Binding.Port:=9000;
     //idudpserver1.Binding.Bind;
     idudpserver1.Active:=true;

     ADOConnection1.ConnectionString:=con;
     try
        ADOConnection1.Connected:=true;
        dbTypabfragen();
     except

     end;
end;

procedure clearScreen();
var  bin:Array of Byte;
begin
  try
    setlength(bin, 2);
    bin[0]:=27;
    bin[1]:=$24;
    form1.idudpserver1.SendBuffer(nquireIP, 9000, TBytes(bin));
  except
     showmessage('Fehler beim Senden! - clearScreen');
  end;
end;

procedure sendeDaten(Position:Integer; s:String);
var bin:Array of Byte;
    i:Integer;
begin
  try
    setlength(bin, length(s)+8);
    bin[0]:=27;
    bin[1]:=$2E;
    bin[2]:=Position;
    for I := 0 to length(s) do begin
       bin[i+3]:=chartobyte(s[i]);
    end;
    bin[i+4]:=$03;
    form1.idudpserver1.SendBuffer(nquireIP, 9000, TBytes(bin));
  except
     showmessage('Fehler beim Senden! - sendeDaten');
  end;
end;

procedure sendeKey(Position:integer; s:String);
var bin:Array of Byte;
    i:Integer;
begin
  try
    setlength(bin, length(s)+7);
    bin[0]:=$1B;
    bin[1]:=$F2;
    for I := 0 to length(s)-1 do begin
       bin[i+2]:=chartobyte(s[i+1]);
    end;
    bin[length(s)+2]:=$0D;
    bin[length(s)+3]:=$0D;
    bin[length(s)+4]:=Position;
    bin[length(s)+5]:=Position;
    bin[length(s)+6]:=$03;
    form1.idudpserver1.SendBuffer(nquireIP, 9000, TBytes(bin));
  except
     showmessage('Fehler beim Senden! - sendeKey');
  end;
end;

{$Warnings off}
function IsInteger(s: string): boolean;
var i, e: integer;
begin
  Val(s,i,e);
  result := e = 0;
end;
{$Warnings on}




procedure TForm1.IdUDPServer1AfterBind(Sender: TObject);
begin

end;

procedure TForm1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
  AData: TBytes; ABinding: TIdSocketHandle);

var s:String;
  i:Integer;
 // bin2:Array of Byte;
begin
    s:='';
    for i := 0 to Length(AData) - 1 do begin
        if(AData[i]<>42)and(AData[i]<>10)then
        s:=s+chr(AData[i]);
    end;
    memo1.Lines.Add(s);
    clearScreen();
    if(pos('gif', s)=0)AND(pos('K8', s)=0)AND(pos('K9', s)=0)AND(pos('Ka', s)=0)AND(pos('Kb', s)=0)then begin
      if(IsInteger(s))then begin
        KartenNr:=s;
      end
      else begin
         sendeDaten(49, 'Bitte nur');
         sendeDaten(52, 'Besucherausweise');
         sendeDaten(55, 'scannen!');
         exit;
      end;
      merker:=testImHaus(s);
      if(merker<>3)then begin
        sendeDaten(49, 'Bitte waehlen Sie aus:');
      end;
      if(merker=0)then begin
        sendeKey(56, 'kommen.gif');
      end;
      if(merker=1)then begin
        sendeKey(56, 'gehen.gif');
      end;
      if(merker<>3)then begin
        sendeKey(97, 'abbrechen.gif');
      end;
      if(merker=3)then begin
          sendeDaten(49, 'Kein Besuch');
          sendeDaten(52, 'angelegt!');
      end;
    end;
    if(pos('K8', s)<>0)OR (pos('K9', s)<>0)then begin
      if(merker=0)then begin merker:=1; end
      else merker:=0;
      if(length(KartenNr)<>0)then begin
        updateBesucherstatus(inttostr(merker));
        Besuchsvorgang_archivieren();
        sendeDaten(49, 'Buchung');
        sendeDaten(52,'erfolgreich!');
      end;
      KartenNr:='';
    end;
    if(pos('Ka', s)<>0)OR (pos('Kb', s)<>0)then begin
      if(length(KartenNr)<>0)then begin
        sendeDaten(49, 'Vorgang');
        sendeDaten(52, 'abgebrochen!');
      end;
      KartenNr:='';
    end;
end;



function testImHaus(KartenNr:String):integer;
begin
  try
    Form1.Abfrage.Close;
    Form1.Abfrage.CommandText:='select imHaus from Besucher where KartenNr='''+KartenNr+'''';
    Form1.Abfrage.Open;
    if(Form1.Abfrage.RecordCount=0)then begin
       Result:=3;
       Form1.Abfrage.Close;
    end
    else begin
       Result:=Form1.Abfrage.FieldByName('imHaus').AsInteger;
       Form1.Abfrage.Close;
    end;
  except On E: Exception do
     Logbucheintrag(4, '[testImHaus/Nquire]-'+E.ToString);
  end;
end;

procedure updateBesucherstatus(imHaus:String);
begin
  try
   Form1.Einfuegen.Close;
   Form1.Einfuegen.SQL.Text:='Update Besucher set ImHaus='''+imHaus+''' where KartenNr='''+KartenNr+'''';
   Form1.Einfuegen.ExecSQL;
   Form1.Einfuegen.Close;
  except On E: Exception do
     Logbucheintrag(4, '[updateBesucherstatus/Nquire]-'+E.ToString);
  end;
end;

procedure Logbucheintrag(Typ: integer; Nachricht: string);
var n, Platz: string;
begin
  try
   n:=StringReplace(Nachricht,'''','"',[rfReplaceAll]);
   Platz:='NQuire Self Booking Terminal';
   Form1.Einfuegen.Close;
   Form1.Einfuegen.SQL.Text:='INSERT INTO Logbuch (Platz,Logtyp,Datum,LogMessage) VALUES ('''+Platz+''','+
             IntToStr(Typ)+','+AktDate+','''+n+''')';
   Form1.Einfuegen.ExecSQL;
   Form1.Einfuegen.Close;
  except On E: Exception do
     //Logbucheintrag(4, '[Logbookentry]-'+E.ToString);
  end;
end;

procedure Besuchsvorgang_archivieren();
var Besuchsvorgang:Array of String;
begin
  try
    setlength(Besuchsvorgang, 17);
    Form1.Abfrage.CommandText:='select InfoIndex,Besucherindex,Bezeichnung,Anrede,Nachname,Vorname,Firmenname,'+
               'Optionen,GueltigkeitBeginn,GueltigkeitEnde,MitarbeiterName,Kostenstelle,Bearbeiter,'+
               'TelefonMitarbeiter,ImHaus,Ort, KFZ, Besucherkategorie from Besuchergruppe left join Besucher '+
               'on (Besucher.Gruppenindex=Besuchergruppe.Gruppenindex) where KartenNr='''+KartenNr+'''';
    Form1.Abfrage.Open;
    Besuchsvorgang[0]:=Form1.Abfrage.FieldByName('InfoIndex').AsString;
    Besuchsvorgang[1]:=Form1.Abfrage.FieldByName('Besucherindex').AsString;
    Besuchsvorgang[2]:=Form1.Abfrage.FieldByName('Bezeichnung').AsString;
    Besuchsvorgang[3]:=Form1.Abfrage.FieldByName('Anrede').AsString;
    Besuchsvorgang[4]:=Form1.Abfrage.FieldByName('Nachname').AsString;
    Besuchsvorgang[5]:=Form1.Abfrage.FieldByName('Vorname').AsString;
    Besuchsvorgang[6]:=Form1.Abfrage.FieldByName('Firmenname').AsString;
    Besuchsvorgang[7]:=GetDateTimeString(strtodatetime(Form1.Abfrage.FieldByName('GueltigkeitBeginn').AsString));
    Besuchsvorgang[8]:=GetDateTimeString(strtodatetime(Form1.Abfrage.FieldByName('GueltigkeitEnde').AsString));
    Besuchsvorgang[9]:=Form1.Abfrage.FieldByName('MitarbeiterName').AsString;
    Besuchsvorgang[10]:=Form1.Abfrage.FieldByName('Kostenstelle').AsString;
    Besuchsvorgang[11]:=Form1.Abfrage.FieldByName('Bearbeiter').AsString;
    Besuchsvorgang[12]:=Form1.Abfrage.FieldByName('TelefonMitarbeiter').AsString;
    Besuchsvorgang[13]:=Form1.Abfrage.FieldByName('ImHaus').AsString;
    Besuchsvorgang[14]:=Form1.Abfrage.FieldByName('Ort').AsString;
    Besuchsvorgang[15]:=Form1.Abfrage.FieldByName('KFZ').AsString;
    Besuchsvorgang[16]:=Form1.Abfrage.FieldByName('Besucherkategorie').AsString;
    Form1.Einfuegen.SQL.Text:='INSERT INTO BesucherArchiv (InfoIndex,Besucherindex,Bezeichnung,Anrede,Nachname,Vorname,Firmenname,KartenNr,'+
               'GueltigkeitBeginn,GueltigkeitEnde,MitarbeiterName,Kostenstelle,Bearbeiter,'+
               'TelefonMitarbeiter,ImHaus,Ort, KFZ, Besucherkategorie) VALUES ('''+
               Besuchsvorgang[0]+''','''+
               Besuchsvorgang[1]+''','+
               ''''+Besuchsvorgang[2]+''','+
               ''''+Besuchsvorgang[3]+''','+
               ''''+Besuchsvorgang[4]+''','+
               ''''+Besuchsvorgang[5]+''','+
               ''''+Besuchsvorgang[6]+''','+
               ''''+KartenNr+''','+
               ''+Besuchsvorgang[7]+','+
               ''+Besuchsvorgang[8]+','+
               ''''+Besuchsvorgang[9]+''','+
               ''''+Besuchsvorgang[10]+''','+
               ''''+Besuchsvorgang[11]+''','+
               ''''+Besuchsvorgang[12]+''','+
               ''''+inttostr(merker)+''','+
               ''''+Besuchsvorgang[14]+''','+
               ''''+Besuchsvorgang[15]+''','+
               ''''+Besuchsvorgang[16]+''')';
    Form1.Einfuegen.ExecSQL;
  except On E: Exception do
     Logbucheintrag(4, '[Besuchsvorgang_archivieren/Nquire]-'+E.ToString);
  end;
end;

function GetDateTimeString(dt:TDateTime):string;
begin
  try
      if(DBTyp='MSSQL')then begin
                     DateTimeToString(result,'yyyymmdd hh:nn:ss',dt);
                     result:='convert(char(18),'''+result+''',126)';
                   end;
      if(DBTyp='ORACLE')then begin
                   DateTimeToString(result,'dd.mm.yyyy hh:nn:ss',dt);
                   result:='to_date('''+result+''',''DD.MM.YYYY HH24:MI:SS'')';
                 end;
      if(DBTyp='MYSQL')then begin
             DateTimeToString(result,'yyyymmddhhnnss',dt);
             result:=''''+result+'''';
           end;
  except
     On E: Exception do
            Logbucheintrag(4, '[GetDateTimeString]-'+E.Message);
  end;
end;

procedure dbTypabfragen;
begin
  try
    Form1.Abfrage.Close;
    Form1.Abfrage.CommandText:='SELECT sysdate FROM dual'; //v$spparameter
    Form1.Abfrage.Open;
    AktDate:='sysdate';
    dbTyp:='ORACLE';
    Form1.Abfrage.Close;
  except
    try
      Form1.Abfrage.Close;
      Form1.Abfrage.CommandText:='SELECT NOW()';//INFORMATION_SCHEMA.SCHEMATA';
      Form1.Abfrage.Open;
      AktDate:='now()';
      dbTyp:='MYSQL';
      Form1.Abfrage.Close;
    except
       Form1.Abfrage.Close;
       Form1.Abfrage.CommandText:='SELECT GETDATE() AS Datum';
       Form1.Abfrage.Open;
       AktDate:='GETDATE()';
       dbTyp:='MSSQL';
       Form1.Abfrage.Close;
    end;
  end;
end;


procedure TForm1.IPAdresseNquire1Click(Sender: TObject);
begin
  form4.showmodal;
end;

end.

Klaus01 23. Jan 2015 10:43
AW: Anwednung in Dienst umwandeln
 
Hallo,

ich würde eine neue Service Application erstellen.
In dieser dann die "umgebaute" Unit1 (MADABarcode) verwenden.

Ein Service verträgt sich nicht mit etwaigen GUI Controls oder showMessage Ausgaben.


Grüße
Klaus

OlafSt 23. Jan 2015 12:28
AW: Anwednung in Dienst umwandeln
 
Anders ausgedrückt: Services können nichts anzeigen. Keine Formulare, keine MessageBoxen, nichts. Sie tun stumm ihre Arbeit, ohne das jemand was davon merkt. Und nein, es gibt keine Tricks (so wie unter XP damals), um das doch noch hinzukriegen.

Dahingehend mußt du deine Anwendung umbauen.

Bernhard Geyer 23. Jan 2015 12:36
AW: Anwednung in Dienst umwandeln
 
Zitat:
Zitat von OlafSt (Beitrag 1287555)
Anders ausgedrückt: Services können nichts anzeigen. Keine Formulare, keine MessageBoxen, nichts. Sie tun stumm ihre Arbeit, ohne das jemand was davon merkt. Und nein, es gibt keine Tricks (so wie unter XP damals), um das doch noch hinzukriegen.
Soooo stimmt das nicht. Serviceanwendungen können sehr wohl das o.g. anzeigen.
Das Problem ist das diese nicht auf dem Desktop geschieht den der normale User hat und man auch nicht (wie unter XP) sagen kann: "Nimm den Desktop des angemeldeten Users".
Man kann also sehr wohl sein Anwendungsfenster anzeigen - solange sie keine Interaktion mit dem User benötigen.
Verwenden wir (bzw. unsere Kunden) häufig um unsere Anwendung (per COM) zu automatisieren. Es werden (wei interaktiv) die Fenster angezeigt und verschwinden wieder - halt auf einem Desktop von dem der angemeldete User nix mitbekommt.

arizona88 26. Jan 2015 07:29
AW: Anwednung in Dienst umwandeln
 
also ich hab das jetzt mal über das Wochenende versucht.


Leider bekomme ich irgendwie keine verbindung zur Datenbank. So wie ich das sehe :oops:

Habe alle Buttons und alles entfernt Stimmt das so? beim Debugen bekomme ich natürlich assambler code den ich garnicht verstehe !!!

Delphi-Quellcode:
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr,
  Vcl.Dialogs,StdCtrls, Sockets, OverbyteIcsWndControl, OverbyteIcsWSocket,
  IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer, IDSocketHandle, IniFiles,
  ADODB, DB;

type
  TService1 = class(TService)
    IdUDPServer1: TIdUDPServer;
    ADOConnection1: TADOConnection;
    Einfuegen: TADOQuery;
    Abfrage: TADODataSet;
    procedure IdUDPServer1UDPRead(AThread: TIdUDPListenerThread; AData: TBytes;
      ABinding: TIdSocketHandle);
    procedure ServiceExecute(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    function GetServiceController: TServiceController; override;
    { Public-Deklarationen }
  end;

   type
  Tbuf = record
    case boolean of
      true : (ch : char);
      false : (b : byte);
    end;

var
  Service1: TService1;
  merker:Integer;
  Con, nquireIP, AktDate, KartenNr, dbTyp, serverip:String;
  procedure clearScreen();
  function chartobyte(ch : char) : byte;
  procedure sendeKey(Position:integer; s:String);
  procedure sendeDaten(Position:Integer; s:String);
  procedure Logbucheintrag(Typ: integer; Nachricht: string);
  function testImHaus(KartenNr:String):integer;
  procedure updateBesucherstatus(imHaus:String);
  procedure dbTypabfragen;
  procedure Besuchsvorgang_archivieren();
  function GetDateTimeString(dt:TDateTime):string;
implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  Service1.Controller(CtrlCode);
end;

function TService1.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

 function chartobyte(ch : char) : byte;
var buf : Tbuf;
begin
buf.ch := ch;
result := buf.b
end;

procedure TService1.ServiceExecute(Sender: TObject);
var DelphiIni : TInIFile;
    Pfadname:shortString;
    Binding: TIdSocketHandle;
begin
     Pfadname := ParamStr(0);
     while(length(Pfadname)>0)and(Pfadname[length(Pfadname)]<>'\')do dec(Pfadname[0]);
     DelphiIni:= TIniFile.Create(Pfadname+'BM.ini');
     Con:=DelphiIni.ReadString('SYSTEM', 'DBCONNECTION', '');
     nquireIP:=DelphiIni.ReadString('Nquire', 'IP', '');
     serverip:=DelphiIni.ReadString('Nquire', 'Server-IP', '');
     if(length(nquireIP)=0)then begin
       // showmessage('Bitte Ip-Adresse des NQuire Gerätes eintragen!');
        nquireIP:='192.168.0.221';
     end;
     Binding := idudpserver1.Bindings.add;
     Binding.IP:=serverip;
     Binding.Port:=9000;
     //idudpserver1.Binding.Bind;
     idudpserver1.Active:=true;

     ADOConnection1.ConnectionString:=con;
     try
        ADOConnection1.Connected:=true;
        dbTypabfragen();
     except

     end;
end;

procedure clearScreen();
var  bin:Array of Byte;
begin
  try
    setlength(bin, 2);
    bin[0]:=27;
    bin[1]:=$24;
    service1.idudpserver1.SendBuffer(nquireIP, 9000, TBytes(bin));
  except
    // showmessage('Fehler beim Senden! - clearScreen');
  end;
end;

procedure sendeDaten(Position:Integer; s:String);
var bin:Array of Byte;
    i:Integer;
begin
  try
    setlength(bin, length(s)+8);
    bin[0]:=27;
    bin[1]:=$2E;
    bin[2]:=Position;
    for I := 0 to length(s) do begin
       bin[i+3]:=chartobyte(s[i]);
    end;
    bin[i+4]:=$03;
    service1.idudpserver1.SendBuffer(nquireIP, 9000, TBytes(bin));
  except
    // showmessage('Fehler beim Senden! - sendeDaten');
  end;
end;

procedure sendeKey(Position:integer; s:String);
var bin:Array of Byte;
    i:Integer;
begin
  try
    setlength(bin, length(s)+7);
    bin[0]:=$1B;
    bin[1]:=$F2;
    for I := 0 to length(s)-1 do begin
       bin[i+2]:=chartobyte(s[i+1]);
    end;
    bin[length(s)+2]:=$0D;
    bin[length(s)+3]:=$0D;
    bin[length(s)+4]:=Position;
    bin[length(s)+5]:=Position;
    bin[length(s)+6]:=$03;
    service1.idudpserver1.SendBuffer(nquireIP, 9000, TBytes(bin));
  except
   //  showmessage('Fehler beim Senden! - sendeKey');
  end;
end;

{$Warnings off}
function IsInteger(s: string): boolean;
var i, e: integer;
begin
  Val(s, i, e);
  result := e = 0;
end;
{$Warnings on}

procedure TService1.IdUDPServer1UDPRead(AThread: TIdUDPListenerThread;
  AData: TBytes; ABinding: TIdSocketHandle);

var s:String;
  i:Integer;
  bin2:Array of Byte;
begin
    s:='';
    for i := 0 to Length(AData) - 1 do begin
        if(AData[i]<>42)and(AData[i]<>10)then
        s:=s+chr(AData[i]);
    end;

    clearScreen();
    if(pos('gif', s)=0)AND(pos('K8', s)=0)AND(pos('K9', s)=0)AND(pos('Ka', s)=0)AND(pos('Kb', s)=0)then begin
      if(IsInteger(s))then begin
        KartenNr:=s;
      end
      else begin
         sendeDaten(49, 'Bitte nur');
         sendeDaten(52, 'Besucherausweise');
         sendeDaten(55, 'scannen!');
         exit;
      end;
      merker:=testImHaus(s);
      if(merker<>3)then begin
        sendeDaten(49, 'Bitte waehlen Sie aus:');
      end;
      if(merker=0)then begin
        sendeKey(56, 'kommen.gif');
      end;
      if(merker=1)then begin
        sendeKey(56, 'gehen.gif');
      end;
      if(merker<>3)then begin
        sendeKey(97, 'abbrechen.gif');
      end;
      if(merker=3)then begin
          sendeDaten(49, 'Kein Besuch');
          sendeDaten(52, 'angelegt!');
      end;
    end;
    if(pos('K8', s)<>0)OR (pos('K9', s)<>0)then begin
      if(merker=0)then begin merker:=1; end
      else merker:=0;
      if(length(KartenNr)<>0)then begin
        updateBesucherstatus(inttostr(merker));
        Besuchsvorgang_archivieren();
        sendeDaten(49, 'Buchung');
        sendeDaten(52,'erfolgreich!');
      end;
      KartenNr:='';
    end;
    if(pos('Ka', s)<>0)OR (pos('Kb', s)<>0)then begin
      if(length(KartenNr)<>0)then begin
        sendeDaten(49, 'Vorgang');
        sendeDaten(52, 'abgebrochen!');
      end;
      KartenNr:='';
    end;
end;

function testImHaus(KartenNr:String):integer;
begin
  try
    Service1.Abfrage.Close;
    Service1.Abfrage.CommandText:='select imHaus from Besucher where KartenNr='''+KartenNr+'''';
    Service1.Abfrage.Open;
    if(Service1.Abfrage.RecordCount=0)then begin
       Result:=3;
       Service1.Abfrage.Close;
    end
    else begin
       Result:=Service1.Abfrage.FieldByName('imHaus').AsInteger;
       Service1.Abfrage.Close;
    end;
  except On E: Exception do
     Logbucheintrag(4, '[testImHaus/Nquire]-'+E.ToString);
  end;
end;

procedure updateBesucherstatus(imHaus:String);
begin
  try
   Service1.Einfuegen.Close;
   Service1.Einfuegen.SQL.Text:='Update Besucher set ImHaus='''+imHaus+''' where KartenNr='''+KartenNr+'''';
   Service1.Einfuegen.ExecSQL;
   Service1.Einfuegen.Close;
  except On E: Exception do
     Logbucheintrag(4, '[updateBesucherstatus/Nquire]-'+E.ToString);
  end;
end;

procedure Logbucheintrag(Typ: integer; Nachricht: string);
var n, Platz: string;
begin
  try
   n:=StringReplace(Nachricht,'''','"',[rfReplaceAll]);
   Platz:='NQuire Self Booking Terminal';
   Service1.Einfuegen.Close;
   Service1.Einfuegen.SQL.Text:='INSERT INTO Logbuch (Platz,Logtyp,Datum,LogMessage) VALUES ('''+Platz+''','+
             IntToStr(Typ)+','+AktDate+','''+n+''')';
   Service1.Einfuegen.ExecSQL;
   Service1.Einfuegen.Close;
  except On E: Exception do
     //Logbucheintrag(4, '[Logbookentry]-'+E.ToString);
  end;
end;

procedure Besuchsvorgang_archivieren();
var Besuchsvorgang:Array of String;
begin
  try
    setlength(Besuchsvorgang, 17);
    Service1.Abfrage.CommandText:='select InfoIndex,Besucherindex,Bezeichnung,Anrede,Nachname,Vorname,Firmenname,'+
               'Optionen,GueltigkeitBeginn,GueltigkeitEnde,MitarbeiterName,Kostenstelle,Bearbeiter,'+
               'TelefonMitarbeiter,ImHaus,Ort, KFZ, Besucherkategorie from Besuchergruppe left join Besucher '+
               'on (Besucher.Gruppenindex=Besuchergruppe.Gruppenindex) where KartenNr='''+KartenNr+'''';
    Service1.Abfrage.Open;
    Besuchsvorgang[0]:=Service1.Abfrage.FieldByName('InfoIndex').AsString;
    Besuchsvorgang[1]:=Service1.Abfrage.FieldByName('Besucherindex').AsString;
    Besuchsvorgang[2]:=Service1.Abfrage.FieldByName('Bezeichnung').AsString;
    Besuchsvorgang[3]:=Service1.Abfrage.FieldByName('Anrede').AsString;
    Besuchsvorgang[4]:=Service1.Abfrage.FieldByName('Nachname').AsString;
    Besuchsvorgang[5]:=Service1.Abfrage.FieldByName('Vorname').AsString;
    Besuchsvorgang[6]:=Service1.Abfrage.FieldByName('Firmenname').AsString;
    Besuchsvorgang[7]:=GetDateTimeString(strtodatetime(Service1.Abfrage.FieldByName('GueltigkeitBeginn').AsString));
    Besuchsvorgang[8]:=GetDateTimeString(strtodatetime(Service1.Abfrage.FieldByName('GueltigkeitEnde').AsString));
    Besuchsvorgang[9]:=Service1.Abfrage.FieldByName('MitarbeiterName').AsString;
    Besuchsvorgang[10]:=Service1.Abfrage.FieldByName('Kostenstelle').AsString;
    Besuchsvorgang[11]:=Service1.Abfrage.FieldByName('Bearbeiter').AsString;
    Besuchsvorgang[12]:=Service1.Abfrage.FieldByName('TelefonMitarbeiter').AsString;
    Besuchsvorgang[13]:=Service1.Abfrage.FieldByName('ImHaus').AsString;
    Besuchsvorgang[14]:=Service1.Abfrage.FieldByName('Ort').AsString;
    Besuchsvorgang[15]:=Service1.Abfrage.FieldByName('KFZ').AsString;
    Besuchsvorgang[16]:=Service1.Abfrage.FieldByName('Besucherkategorie').AsString;
    Service1.Einfuegen.SQL.Text:='INSERT INTO BesucherArchiv (InfoIndex,Besucherindex,Bezeichnung,Anrede,Nachname,Vorname,Firmenname,KartenNr,'+
               'GueltigkeitBeginn,GueltigkeitEnde,MitarbeiterName,Kostenstelle,Bearbeiter,'+
               'TelefonMitarbeiter,ImHaus,Ort, KFZ, Besucherkategorie) VALUES ('''+
               Besuchsvorgang[0]+''','''+
               Besuchsvorgang[1]+''','+
               ''''+Besuchsvorgang[2]+''','+
               ''''+Besuchsvorgang[3]+''','+
               ''''+Besuchsvorgang[4]+''','+
               ''''+Besuchsvorgang[5]+''','+
               ''''+Besuchsvorgang[6]+''','+
               ''''+KartenNr+''','+
               ''+Besuchsvorgang[7]+','+
               ''+Besuchsvorgang[8]+','+
               ''''+Besuchsvorgang[9]+''','+
               ''''+Besuchsvorgang[10]+''','+
               ''''+Besuchsvorgang[11]+''','+
               ''''+Besuchsvorgang[12]+''','+
               ''''+inttostr(merker)+''','+
               ''''+Besuchsvorgang[14]+''','+
               ''''+Besuchsvorgang[15]+''','+
               ''''+Besuchsvorgang[16]+''')';
    Service1.Einfuegen.ExecSQL;
  except On E: Exception do
     Logbucheintrag(4, '[Besuchsvorgang_archivieren/Nquire]-'+E.ToString);
  end;
end;


function GetDateTimeString(dt:TDateTime):string;
begin
  try
      if(DBTyp='MSSQL')then begin
                     DateTimeToString(result,'yyyymmdd hh:nn:ss',dt);
                     result:='convert(char(18),'''+result+''',126)';
                   end;
      if(DBTyp='ORACLE')then begin
                   DateTimeToString(result,'dd.mm.yyyy hh:nn:ss',dt);
                   result:='to_date('''+result+''',''DD.MM.YYYY HH24:MI:SS'')';
                 end;
      if(DBTyp='MYSQL')then begin
             DateTimeToString(result,'yyyymmddhhnnss',dt);
             result:=''''+result+'''';
           end;
  except
     On E: Exception do
            Logbucheintrag(4, '[GetDateTimeString]-'+E.Message);
  end;
end;


 procedure dbTypabfragen;
begin
  try
    Service1.Abfrage.Close;
    Service1.Abfrage.CommandText:='SELECT sysdate FROM dual'; //v$spparameter
    Service1.Abfrage.Open;
    AktDate:='sysdate';
    dbTyp:='ORACLE';
    Service1.Abfrage.Close;
  except
    try
      Service1.Abfrage.Close;
      Service1.Abfrage.CommandText:='SELECT NOW()';//INFORMATION_SCHEMA.SCHEMATA';
      Service1.Abfrage.Open;
      AktDate:='now()';
      dbTyp:='MYSQL';
      Service1.Abfrage.Close;
    except
       Service1.Abfrage.Close;
       Service1.Abfrage.CommandText:='SELECT GETDATE() AS Datum';
       Service1.Abfrage.Open;
       AktDate:='GETDATE()';
       dbTyp:='MSSQL';
       Service1.Abfrage.Close;
    end;
  end;
end;





end.

Dann bekomme ich nach der installation diesen fehler

7712000B 90 nop
ntdll.DbgBreakPoint:
7712000C CC int 3
7712000D C3 ret

Bernhard Geyer 26. Jan 2015 08:03
AW: Anwednung in Dienst umwandeln
 
1, Wenn du bei ADO über ODBC gehst solltest du diesen Eintrag als System-DSN anlegen. Als Benutzer-DNS wird diese der System-Dienst nicht sehen.

2, Oracle und ADO? Nimmst du den (Proof of Concept) Treiber von MS hierfür?

arizona88 26. Jan 2015 08:43
AW: Anwednung in Dienst umwandeln
 
Danke für die Schnelle antwort.

Ich habe bei mir schon die System-DSN eingerichtet. Bei mir läuft alles darüber.


Oracle und ADO? Nimmst du den (Proof of Concept) Treiber von MS hierfür?

Weiß jetzt nicht ganz genau was du meinst.

Meine verbindung zur db sieht so aus (kann dann über den ODBC Triber eingestellt werden welche db verwendet wird)...

DBCONNECTION=Provider=MSDASQL.1;Persist Security Info=True;User ID=root;Data Source=BM10

Ganz am ende mache ich nur ne abfrage welche db verwendet wird damit ich das Datum richtig abfrage.


Kann es eventuell daran liegen das ich den Service als win32 erstelle und meine ODBC connect im sysWOW64 liegt und er auf die falsche odbc zugreift?(nämlich die aus dem system32 orderner)

p80286 26. Jan 2015 10:17
AW: Anwendung in Dienst umwandeln
 
Ich habe unter W7 folgende Oracle Anbindung:
Provider=OraOLEDB.Oracle.1;Password=xxxxxxx;Persis t Security Info=True;User ID=xxxxxxxx;Data Source=DBName
Der MS-Treiber ist nicht so empfehlenswert, der hat ein massives Problem mit den Gleitkommazahlen (soweit mir bekannt)


Gruß
K-H

arizona88 26. Jan 2015 10:50
AW: Anwendung in Dienst umwandeln
 
Ja es geht eigentlich nicht um Oracle ich benutze hauptsächlich mssql und mysql. die oracle funktion ist nur schon drin für den fall das es später mal dazukommt. Diese wird auch nicht abgefragt wenn eine der Anderen 2 Verbindungen bestehen. vorerst möchte ich mal mssql aber leider klappt das nicht. Irgendwie kommt keine verbindung zustanden.

arizona88 26. Jan 2015 12:30
AW: Anwendung in Dienst umwandeln
 
Würde mein Programm so funktionieren wie es jetzt ist?
Vielleciht sollte ich noch schreiben was ich machen möchte! Ich versuche mit einem Barcodescanner auf eine Datenbank zuzugreifen. Der barcodescanner liest eine nummer und vergleicht diese mit der DFatenbank das ganze geschieht über ethernet. Also nur das Programm als anwendung funktioniert ich wollte das ganze jetzt als service haben.

Ich komme einfach nciht drauf warum die verbindung nicht klappt


Alle Zeitangaben in WEZ +1. Es ist jetzt 19:36 Uhr.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz