Anwendung in Dienst umwandeln

[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