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.