[DELPHI] Usługi systemowe w MS Windows 7

Ma ktoś jakiś przykładowy kod z" CreateProcesAsUser" dla delphi bo nie mogę go <ort>znaleŹĆ</ort>:/

[size=9][color=#999999]Dodano po 2 [godziny] 12 [minuty]:[/color][/size]

Próbowałem przenieść kod z procesu na usługę systemową, niestety wystąpiło parę błędów <ort>o to</ort> kod:
[code]unit Unit1;

interface

uses
Windows, Messages, SysUtils,Variants, Classes, Graphics, Controls, SvcMgr, Dialogs,
ExtCtrls, Shellapi, IdBaseComponent, IdComponent, IdCustomHTTPServer, IdContext, IdHTTPServer,
StdCtrls, ComCtrls, IdCustomTCPServer, IdSocketHandle, MMSystem, CPort, CPortCtl;

type
TService1 = class(TService)
Timer1: TTimer;

procedure ServiceExecute(Sender: TService);
procedure Timer1Timer(Sender: TObject);
procedure ServiceCreate(Sender: TObject);

private
{ Private declarations }
public

function GetServiceController: TServiceController; override;
{ Public declarations }

protected

end;

var
Service1: TService1;
IdHTTPServer1: TIdHTTPServer;
ComPort1: TComPort;
FHTMLDir: string;
FTemplate: string;
Timer2: TTimer;
Handle:THandle;

procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
procedure StartHttpServer(Sender: TObject);
procedure PGComPortComunication(z1:AnsiString; var z2:Real);

implementation

//uses Unit2;

{$R *.DFM}

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

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

procedure TService1.ServiceCreate(Sender: TObject);
begin
FHTMLDir := ExtractFilePath(Application.GetNamePath) + 'HTML';

end;

procedure TService1.ServiceExecute(Sender: TService);
begin
Timer1.Enabled := True;
while not Terminated do
ServiceThread.ProcessRequests(True);// wait for termination
Timer1.Enabled := False;
end;

procedure IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
LFilename: string;
LPathname: string;
label skok_w_petli; //Funkcja skoku jeżeli Timer1 będzie false (powoduje czekanie aż do Timer1 = True)
begin
LFilename := ARequestInfo.Document;
if AnsiSameText(LFilename, '/elisia.htm') then begin
//Ask(ARequestInfo, AResponseInfo);
end else begin
if LFilename = '/' then begin
LFilename := '/index.htm';
end;
//Jeżeli chce index.htm to go generuje jeżeli nie chce to pomija tego if'a
if LFilename = '/index.htm' then begin
AResponseInfo.ContentText := ''

'<html>'
'<head>'
'<meta http-equiv="Refresh" content="10" />'
'</head>'
'<body>'
'
AVATAR CONTROL SYSTEM (BETA1)
'
'
' '
' '
'
SERWER</td>'
' </td>'
' '
'
ONLINE</td>'
' </td>'
' </td>'
' </tr>'
' '
' '
'
KLIENT 1</td>'
' </td>'
' '
'
OFFLINE</td>'
' </td>'
' </td>'
' </tr>'
' '
' '
'
KLIENT 2</td>'
' </td>'
' '
'
OFFLINE</td>'
' </td>'
' </td>'
' </tr>'
' '
' '
'
KLIENT 3</td>'
' </td>'
' '
'
OFFLINE</td>'
' </td>'
' </td>'
' </tr>'
' '
' '
'
UPS PRIMARY</td>'
' </td>';
if Timer2.Enabled =true then
begin
AResponseInfo.ContentText := AResponseInfo.ContentText + ' '
- '
 ONLINE</td>'
 end
 else
 begin
 AResponseInfo.ContentText := AResponseInfo.ContentText + ' '
- '
 OFFLINE</td>'
 end;
 AResponseInfo.ContentText := AResponseInfo.ContentText + ' </td>'
' </td>'
' </tr>'
'</table>'
'
' '
'UPS PRIMARY '

'(POWER %)</td>'

</li>

' </td>'

'</td>'

'</tr>'

' </td>'

'</tr>'

'</table>'

'</body>'

'</html>';
end;

LPathname := FHTMLDir + LFilename;
if FileExists(LPathname) then begin
//AResponseInfo.ContentStream := TFileStream.Create(LPathname, fmOpenRead + fmShareDenyWrite);
//Kod dla zapisu do pliku !
skok_w_petli:
if Timer2.Enabled = false then //Pętla czekania na Timer dla wysyłania obrazka przez http
begin
Sleep(100);
goto skok_w_petli;
end;

if Timer2.Enabled = true then
  begin
    try
      ///Richedit1.Lines.Add('OK');
      ///ms.Position := 0;
      ///Image1.Picture.Bitmap.LoadFromStream(ms);
      ///ms.Position := 0;
      AResponseInfo.ContentStream := TMemoryStream.Create();
      AResponseInfo.ContentStream.Position := 0;
      ///AResponseInfo.ContentStream.CopyFrom(ms, ms.Size);
    except
     //Komunikat błędów
    end;
  end;

end else begin
AResponseInfo.ResponseNo := 404;
AResponseInfo.ContentText := 'The requested URL ' + ARequestInfo.Document
+ ' was not found on this server.';
end;
end;
end;

</ul>

procedure StartHttpServer(Sender: TObject);
var
//do uses dodać: idSocketHandle
Binding : TIdSocketHandle;
begin
//włączenie serwera
if not IdHTTPServer1.Active then
begin
IdHTTPServer1.DefaultPort := 80;
IdHTTPServer1.Bindings.Clear;
Binding := IdHTTPServer1.Bindings.Add;
Binding.Port := StrToIntDef(inttostr(IdHTTPServer1.DefaultPort), 80);
Binding.IP := '192.168.0.25';
try
IdHTTPServer1.Active := true;
except
on e: exception do
begin
ShowMessage(format('Exception %s in Activate. Error is:"%s".', [e.ClassName, e.Message]));
end;
end;
end;
if IdHTTPServer1.Active then
begin
Showmessage('HTTP Serwer właczony!.' + #13 + 'Nasłuchiwanie na porcie: ' + inttostr(IdHTTPServer1.DefaultPort));
end;
end;

procedure PGComPortComunication(z1:AnsiString; var z2:Real);
var
a : real;
b : string[5];
c : string;
begin
b:='32,4';
ComPort1.WriteStr(z1);//+CHR(13)); {Send modem Command}
Sleep(5);
ComPort1.ReadStr(z1,80);
c:= copy(z1,0,1);
if (c = '0') or (c = '1') then
begin
try
*/b := AnsiReplaceStr(z1, '.', ','); *Zamiana znaku - przecinka na kropke
//Delete(w,1,1);
//RichEdit1.Lines.Add((S));
//Trim(S);
a := strtofloat(b);
except
a := 100.00;
end;
z2:= a;
Delete(z1,6,2);
///RichEdit1.Lines.Add(z1);
///RichEdit1.Lines.Add(c);
end else begin
///RichEdit1.Lines.Add('Wystąpił znak:'+ z1);
end;
end;

procedure TService1.Timer1Timer(Sender: TObject);
const
FileName = 'c:\logdate.txt';
var
F: TextFile;
SI:TStartupInfo;
PI:TProcessInformation;
begin
Timer1.Enabled := false;

//ShellExecute(Handle, nil, 'C:\Users\Serwis\Documents\RAD Studio\Projects\AVATAR HTTP CLIENT\Project1.exe', nil, nil, SW_SHOWNORMAL);

//CreateProcess(nil,PChar('C:\Users\Serwis\Documents\RAD Studio\Projects\AVATAR HTTP CLIENT\Project1.exe'), nil,nil,FALSE,NORMAL_PRIORITY_CLASS,nil,nil,SI,PI);

//WinExec('NazwaProga', SW_SHOW);
{AssignFile(f,FileName);
if FileExists(FileName) then Append(f)
else
Rewrite(f);
writeln(f,DateTimeToStr(Now));
//ShowMessage(DateTimeToStr(Now));
CloseFile(f); }
end;

end.[/code]

Niestety tego :
[code]var
Service1: TService1;
IdHTTPServer1: TIdHTTPServer;
ComPort1: TComPort;
FHTMLDir: string;
FTemplate: string;
Timer2: TTimer;
Handle:THandle;

procedure ServiceExecute(Sender: TService);
procedure Timer1Timer(Sender: TObject);
procedure ServiceCreate(Sender: TObject);[/code]

bo w ogóle nie rozpocznie kompilacji, natomiast tak jak jest pod koniec kompilacji wywala błąd: "Project Project1.exe <ort>reised </ort>exception class <ort>EClassNo Found </ort>with message 'Class TComPort not found'"
Czy może ktoś miał do czynienia z podobnym problemem i wie jak go obejść ?

[DELPHI] Usługi systemowe w MS Windows 7

<font face="Arial" size="3">AVATAR CONTROL SYSTEM (BETA1)</span>

1 użytkowników online, w tym zalogowanych: 0, gości: 1

Praca dla programistów

Forum dyskusyjne

Sprawy administracyjne

O nas

Skontaktuj się z nami