Anwendung in Dienst umwandeln

[arizona88]

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

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]

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]

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]

Zitat von OlafSt:

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]

also ich hab das jetzt mal über das Wochenende versucht.


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

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]

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?