Fórum MS - DOS #339038

Cara eu ja vi como fazer isso com gambearra, q eh tu usar o proprio comando de log do prompt pra gerar um txt, e depois carregar ele no memo, mas eh ridculo utilizar esta manobra..
tem uma API q eu vi uma vez q fazia isso, mas como todos codigos uteis, eu perdi..
se tu conseguir ela, gostaria de ser notificado..
flw :)

Pois é os codigos uteis agente sempre perde :? Mas estou procurando ainda, vi uma dica assim;

WinExec(PChar(´command.com /c format a: /v ´ +Edit1.Text),SW_SHOWNORMAL);

Obs.: O Edit1.Text deverá conter o nome do arquivo, onde irão ser copiados as mensagens

Tentei mas não funciono.... :(
Sera q alguem tem alguma ideia??? Pls....

WinExec(PChar(´command.com /c format a: /v ´ + Edit1.Text),SW_HIDE);

corrigindo seu codigo.. após o /v insere um espaço.. e o SW_HIDE eh pra mostrar a janela em modo oculto, nao abrindo a tela de prompt..
mas tem como fazer isto via API.

nightshade,

Mesmo com o codigo corrigido, esse comando não funcionou... Não foi armazenado nada no arquivo de teste. Tentei um memo mas tambem não deu apesar de ter convertido o valor CARDINAL para STRING, o resultado que tenho apos o comando é ´3´ acho que quer dizer que o comando foi bem sucedido.

Mas vamos continuar tentando. :P

Pessoal achei a solução!!!

Pesquisando alguns codigos em VB, encontrei a solução para Delphi deste enigma :idea: . Vamos aos passos;
1. Primeiro voce devera instalar este arquivo PAS como componente não visual, pois ele nos dara a função para fazer o que precisamos;

unit lib;

interface

uses
Windows,stdctrls, Messages,ExtCtrls, TLHelp32,SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
MAX_PREFERRED_LENGTH = DWord(-1);

type
PUserInfo11 = ^TUserInfo11;
TUserInfo11 = packed record
usri11_name : PWideChar;
usri11_comment : PWideChar;
usri11_usr_comment : PWideChar;
usri11_full_name : PWideChar;
usri11_priv : LongWord;
usri11_auth_flags : LongWord;
usri11_password_age : LongWord;
usri11_home_dir : PWideChar;
usri11_parms : PWideChar;
usri11_last_logon : Longword;
usri11_last_logoff : Longword;
usri11_bad_pw_count : Longword;
usri11_num_logons : Longword;
usri11_logon_server : PWideChar;
usri11_country_code : Longword;
usri11_workstations : PWideChar;
usri11_max_storage : Longword;
usri11_units_per_week : Longword;
usri11_logon_hours : Longword; //PBYTE
usri11_code_page : Longword;
end;
type tuser = record
UserName:String;
Server:String;
FullName:String;
Comment:String;
Flags:DWORD;
UserID:DWORD;
end;

type
WKSTA_USER_INFO_1 = packed record
wkui1_username: PWideChar;
wkui1_logon_domain: PWideChar;
wkui1_oth_domains: PWideChar;
wkui1_logon_server: PWideChar;
end;
PWKSTA_USER_INFO_1 = ^WKSTA_USER_INFO_1 ;

Type USER_INFO_1=record
usri1_name:LPWSTR;
usri1_password:LPWSTR;
usri1_password_age:DWORD;
usri1_priv:DWORD;
usri1_home_dir:LPWSTR;
usri1_comment:LPWSTR;
usri1_flags:DWORD;
usri1_script_path:LPWSTR;
End;
Type USER_INFO_20=record
usri20_name:LPWSTR;
usri20_full_name:LPWSTR;
usri20_comment:LPWSTR;
usri20_flags:DWORD;
usri20_user_id:DWORD;
End;
//***************************************************
// PROCEDUDE/FUNKCIJE *
//***************************************************
function AdjustTokenPrivileges (TokenHandle: THandle; DisableAllPrivileges: BOOL; Const NewState: TTokenPrivileges; BufferLength: DWORD; PreviousState: PTokenPrivileges; ReturnLength: PWORD) : BOOL; Stdcall;
function NetUserAdd(Server:PWideChar;Level:DWORD;Buffer:PChar;ParmError:PChar):LongInt; stdcall; external ´netapi32.dll´;
function KillProcessByID(PID: integer): string;
function GetCompName:string;
function GetUserInfo(var user:tuser;usr:string;srv:string):LongInt;
function NetUserGetInfo(Server:PWideChar;UserName:PWideChar;Level:DWORD;Buffer:Pointer):LongInt; stdcall; external ´netapi32.dll´;
procedure updateProcess;
function GetProcessDescriptionByPos(index: integer): string;
function NetUserSetInfo(Server:PWideChar;UserName:PWideChar;Level:DWORD;Buffer:PChar;ParmError:PChar):LongInt; stdcall; external ´netapi32.dll´;
function NetUserChangePassword(Domain:PWideChar;UserName:PWideChar;OldPassword:PWideChar;NewPassword:PWideChar):LongInt; stdcall; external ´netapi32.dll´;
function AddUser(FUsername,fpassword,fhomedir,fcomment,fscript,fserver:string;privi,flags:cardinal):LongInt;
procedure ExeParser(cmd:string;Msg: Tstrings );
function getwindir:string;
function ExecNewProcess(ProgramName : String):boolean;
function SetUserInfo(fusername,fserver,ffulname,fcomment:string;FFlags,fuserID:dword):LongInt;
function ChangePassword(user,oldpassword,newpassword:string):LongInt;
function diskusage:string;
function uptime:string;
function comments:tstrings;
procedure ListUsers(list: Tstrings; const aServer: string);
function NetUserEnum(ServerName: PWideChar;Level,Filter: DWord;var Buffer: Pointer;PrefMaxLen: DWord;var EntriesRead,TotalEntries,ResumeHandle: DWord): LongWord; stdcall;external ´netapi32.dll´;
Function NetAPIBufferFree(Buffr : Pointer) : LongInt; StdCall; External ´NETAPI32.DLL´ Name ´NetApiBufferFree´;
function NetUserDel(Server:PWideChar;UserName:PWideChar):LongInt; stdcall; external ´netapi32.dll´;
function deluser(server,username:string):longint;
function getwinversion:string;
procedure freeprocess;
function memoryusage:string;
function NetWkstaUserEnum (ServerName: LPWSTR; Level: DWORD; var Buffer: Pointer; PrefMaxLen: DWORD; var EntriesRead, TotalEntries, ResumeHandle: DWORD): Integer; stdcall; external ´netapi32.dll´;
procedure GetUsersForServer(ServerName: WideString; Users: TStrings);
function RebootNT:string;
//****************************************************
//****************************************************

var FUserName:String;
FServer:String;
FFullName:String;
FComment:String;
FFlags:DWORD;
FUserID:DWORD;
ProcessList: array [1..200] of TProcessEntry32;
FCount: integer;

implementation

Function AdjustTokenPrivileges; External ´advapi32.dll´ Name ´AdjustTokenPrivileges´;



function RebootNT:string;
Const
AdjustMsg = ´Could not adjust the Privilege.´ + #1310;
TokenMsg = ´Could not open the Token.´ + 1310;
FailMsg = ´Rebooting Windows has failed´;
succMsg = ´Rebooting Windows...´;
Var
Success : Boolean;
TokenPriv : TTokenPrivileges;
TokenHandle : THandle;
CurrentProc : THandle;
Begin
Success := False;
CurrentProc := GetCurrentProcess;
If OpenProcessToken (CurrentProc,
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TokenHandle) Then
Begin

If LookupPrivilegeValue (Nil, ´SeShutdownPrivilege´,
TokenPriv.Privileges[0].LUID) Then
Begin
TokenPriv.PrivilegeCount := 1;
TokenPriv.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

If AdjustTokenPrivileges (TokenHandle, False, TokenPriv,
0, Nil, Nil) Then
Success := ExitWindowsEx (EWX_REBOOT, 0);
If not Success Then
rebootnt:=AdjustMsg + FailMsg;
End
else
rebootnt:=succMsg;
End
Else
rebootnt:=TokenMsg + FailMsg;
End;



//*******************************************
// add user to a group
//**********************

procedure AddMemberFrom (const id, memberServer : string);
var
sid : PSid;
peUse : SID_NAME_USE;
err : Integer;
sidLen, domainNameLen : DWORD;
domainName : array [0..255] of char;
wServer, wGroup : WideString;
begin
wserver:=´´;
wgroup:=´banka´;

sidLen := 65536;
domainNameLen := 255 + 1;

GetMem (sid, sidLen);
try
if (LookupAccountName (PChar (memberServer), PChar (id), sid, sidLen, domainName, domainNameLen, peUse)) then
begin
showmessage(inttostr(err));
end;
finally
FreeMem (sid)
end
end;
//******************************************
// get logged users
//*******************************************
procedure GetUsersForServer(ServerName: WideString; Users: TStrings);
var
Buffer: Pointer;
EntriesRead,
TotalEntries,
ResumeHandle,
i: DWORD;
UI: PWKSTA_USER_INFO_1;
begin
EntriesRead := 0;
TotalEntries := 0;
ResumeHandle := 0;
try
if NetWkstaUserEnum(PWideChar(ServerName), 1, Buffer, MAX_PREFERRED_LENGTH, EntriesRead, TotalEntries, ResumeHandle) = 0 then begin
UI := PWKSTA_USER_INFO_1(Buffer);
Users.Clear;
for i := 1 to EntriesRead do begin
Users.Add( string(UI^.wkui1_username));
inc(UI);
end;
end;
finally
NetApiBufferFree(Buffer);
end;
end;

//********************************
//WIN VERSION

function getwinversion:string;
var
OS : TOSVersionInfo;
begin
OS.dwOsVersionInfoSize := SizeOf (TOSVersionInfo);
GetVersionEx(OS);
result:= ´Windows NT ´ + inttostr(OS.dwMajorVersion)+´.´+inttostr(OS.dwMinorVersion)+´.´+inttostr(OS.dwbuildnumber)+´ ´+os.szCSDVersion;

end;
//*********************************
//DEL USER
function deluser(server,username:string):longint;
var tServer:Array[0..255] Of WideChar;
tUser:Array[0..255] Of WideChar;
begin
StringToWideChar(server,@tServer,255);
StringToWideChar(UserName,@tUser,255);
Result:=NetUserDel(@tServer,@tUser);

end;



//**********************************
//GET COMMENTS
function comments:tstrings;
var s:tstrings;
whologged:string;
begin
s:=tstringlist.create;
getusersforserver(´´,s);
whologged:=s.Strings[0];
s.clear;
if fileexists(getwindir + ´\profiles\´+whologged +´\desktop\comments.txt´) then begin

s.LoadFromFile(getwindir + ´\profiles\´+whologged +´\desktop\comments.txt´);
end;
comments:=s;

end;

//**********************************
//UPTIME
function uptime:string ;
var min,h:word;
begin
h:=((gettickcount div 1000) div 60) div 60;
min:=((gettickcount div 1000) div 60)-(h*60);
if min>9 then uptime:=inttostr(h) +´:´+ inttostr(min)
else
uptime:=inttostr(h) +´:0´+ inttostr(min);
end;

//*******************************
//MEMORYUSAGE
function memoryusage:string;
var
MS: TMemoryStatus;
s:string;
begin
GlobalMemoryStatus(MS);
s:= ´Total: ´ + FormatFloat(´#,´ KB´´, MS.dwTotalPhys / 1024);
s:= s + ´ Free: ´+inttostr(100-MS.dwMemoryLoad)+´¬´;
memoryusage:=s;
end;


//********************************


//*********************************
//DISKUSAGE
function diskusage:string;
var
AmtFree: Int64;
Total: Int64;
begin

AmtFree := DiskFree(0);
Total := DiskSize(0);
diskusage:= ´Total: ´ + inttostr(total div 1024) + ´ Free: ´ + inttostr(amtfree div 1024)+ ´(´ +floattostrf(((amtfree / total) * 100),ffgeneral,2,4) + ´¬)´;
end;

//**************************************
//COMMAND PROMPT
procedure ExeParser(cmd:string; Msg: Tstrings );
const
LENBUFF = 355;
var
tmp: string;
hReadPipe, hWritePipe: THandle;
sa : TSecurityAttributes;
si : TStartupInfo;
pi : TProcessInformation;
lpBuffer : array[0..lenbuff] of Char;
BytesRead : dword;
BytesToRead : dword;
rb,rw : boolean;
Buffer : string;
BufPos ,i : integer;
FoundNewLine: boolean;
output_line : string;
begin
i:=10;
sa.nLength := sizeof( sa );
sa.lpSecurityDescriptor := nil;
sa.bInheritHandle := True;

if not CreatePipe( hReadPipe, hWritePipe, @sa, 0 ) then begin
//Application.MessageBox( pChar(´Error creation Pipe´ ), ´Error´,IDOK );
exit;
end;

FillChar( si, sizeof(si), 0 );
si.cb := sizeof( si );
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
si.hStdInput := 0;
si.hStdOutput := hWritePipe;
si.hStdError := hWritePipe;

if not CreateProcess( nil, pChar(getwindir + ´\system32\cmd.exe /c ´ + cmd), nil, nil, true, 0, nil, nil, si, pi ) then begin
//Application.MessageBox( pChar(´Error executing command´ ), ´Error´, IDOK );
CloseHandle( hReadPipe );
CloseHandle( hWritePipe );
exit;
end;

CloseHandle( hWritePipe );
BytesToRead := LENBUFF;
BytesRead := 0;
Buffer := ´´;
While (true) do begin

lpbuffer:=´´;
// stringtowidechar
//rb := ReadFile( hReadPipe, lpBuffer, BytesToRead, BytesRead, nil );
rb := ReadFile( hreadpipe, lpbuffer, bytestoread, bytesread, nil );

if ( not rb ) then
if ( length( Buffer ) = 0 ) then break;


Buffer := Buffer + lpBuffer;
foundNewLine := False;
BufPos := Pos( #13, Buffer);

If ( BufPos > 0 ) then begin
foundNewLine := True;
output_line := Copy( Buffer, 1, BufPos-1 );


Msg.Add( output_line );


Buffer := Copy( Buffer, BufPos+2, LENBUFF );
BytesToRead := LENBUFF - Length( Buffer );

end else begin
BytesToRead := LENBUFF;
Msg.Add( Buffer );


Buffer := ´´;
end;

if not foundNewLine then begin
if ( BytesRead = LENBUFF ) then
//Application.MessageBox( pChar(´Long line. Increase buffer length´), ´Error´, IDOK )
else
BytesToRead := LENBUFF - Length( Buffer );

end;

end;
WaitForSingleObject( pi.hProcess, INFINITE );
CloseHandle( pi.hProcess );
CloseHandle( hReadPipe );
end;
//******************************************
//*******GET WIN DIR*****************
function getwindir:string;
var
Buf: array[0..255] of Char;
BufLen: DWord;
begin
BufLen := SizeOf(Buf);
getwindowsdirectory(buf,buflen);
result:=buf;
end;
//**************************************
//LISTS USERS ON SERVER
procedure ListUsers(list: tstrings; const aServer: string);
var
EntriesRead : DWord;
I : Integer;
ResumeHandle : DWord;
Rslt : LongWord;
SessionInfo,
P : PUserInfo11;
TotalEntries : DWord;
TotalSoFar : LongWord;
CName : PWideChar;
aString : string;
intIPAdres : integer;
strIPAdres : string;
xmlstr : string;
begin
ResumeHandle := 0;
TotalSoFar := 0;
xmlstr:=´´;
aString := aServer;
CName := StringToOleStr(aString);
repeat
Rslt := NetUserEnum(CName,
11,
0,
Pointer(SessionInfo),
MAX_PREFERRED_LENGTH,
EntriesRead,
TotalEntries,
ResumeHandle);
if Rslt <> 0 then
begin

end;

P := SessionInfo;
for I := 0 to EntriesRead - 1 do
begin
if WideCharToString(P.usri11_name) <> ´´ then
begin
xmlstr:=´#´; ;

list.Add(xmlstr);
xmlstr:=´´;
end;
Inc(LongWord(P), SizeOf(TUserInfo11))
end;
Inc(TotalSoFar, EntriesRead);
until TotalSoFar >= TotalEntries;


Rslt := NetApiBufferFree(SessionInfo);
if Rslt <> 0 then
list.Add(´or Fout =´ ´ + IntToStr(Rslt) + ´´ meaning=´´ + SysErrorMessage(Rslt) + ´´>´);
end;

//************************************************
//CHANGES THE PASSWORD
function ChangePassword(user,oldpassword,newpassword:string):LongInt;
var Tmp1:Array[0..255] Of WideChar;
Tmp2:Array[0..255] Of WideChar;
Tmp3:Array[0..255] Of WideChar;
Tmp4:Array[0..255] Of WideChar;
begin
StringToWideChar(´´,@Tmp1,255);
StringToWideChar(User,@Tmp2,255);
StringToWideChar(OldPassword,@Tmp3,255);
StringToWideChar(NewPassword,@Tmp4,255);
Result:=NetUserChangePassword(@Tmp1,@Tmp2,@Tmp3,@Tmp4);
end;
//*****************************************
//ADDS A USER
function AddUser(FUsername,fpassword,fhomedir,fcomment,fscript,fserver:string;privi,flags:cardinal):LongInt;
var tUserName:Array[0..255] Of WideChar;
tPassword:Array[0..255] Of WideChar;
tHomeDir:Array[0..255] Of WideChar;
tComment:Array[0..255] Of WideChar;
tScript:Array[0..255] Of WideChar;
tServer:Array[0..255] Of WideChar;
MyInfo:USER_INFO_1;
Where:DWORD;
begin
StringToWideChar(FUserName,@tUserName,255);
StringToWideChar(FPassword,@tPassword,255);
StringToWideChar(FHomeDir,@tHomeDir,255);
StringToWideChar(FComment,@tComment,255);
StringToWideChar(FScript,@tScript,255);
StringToWideChar(FServer,@tServer,255);
MyInfo.usri1_name:=@tUserName;
MyInfo.usri1_password:=@tPassword;
MyInfo.usri1_password_age:=1;
MyInfo.usri1_priv:=privi;
MyInfo.usri1_home_dir:=@tHomeDir;
MyInfo.usri1_comment:=@tComment;
MyInfo.usri1_flags:=flags; // allways include UF_SCRIPT !!!
MyInfo.usri1_script_path:=@tScript;
NetUserAdd(@tServer,1,@MyInfo,@Where);
Result:=Where;
end;

//****************************************************
//EXECS NEW PROCESS
function ExecNewProcess(ProgramName : String):boolean;
var
StartInfo : TStartupInfo;
ProcInfo : TProcessInformation;
CreateOK : Boolean;
begin

{ fill with known state }
FillChar(StartInfo,SizeOf(TStartupInfo),#0);
FillChar(ProcInfo,SizeOf(TProcessInformation),0);
StartInfo.cb := SizeOf(TStartupInfo);
startinfo.lpReserved := nil;
startinfo.lpTitle := nil;
startinfo.lpDesktop := nil;
startinfo.dwX :=123;
startinfo.dwY :=132;
startinfo.dwXSize :=123;
startinfo.dwYSize := 312;
startinfo.dwFlags := 0;
startinfo.wShowWindow := SW_SHOW;
startinfo.lpReserved2 := nil;
startinfo.cbReserved2 := 0;
CreateOK := CreateProcess(pchar(programname),nil, nil, nil,False,
0,
nil, nil, StartInfo, ProcInfo);

{ check to see if successful }
if CreateOK then
begin
CloseHandle(ProcInfo.hProcess);
result:=true;
end
else result:=false;

CloseHandle(ProcInfo.hThread);


//may or may not be needed. Usually wait for child processes
//WaitForSingleObject(ProcInfo.hProcess, INFINITE);
end;
//********************************************
//SET A USER INFO
function SetUserInfo(fusername,fserver,ffulname,fcomment:string;FFlags,fuserID:dword):LongInt;
var TheUser:Array[0..255] Of WideChar;
TheServer:Array[0..255] Of WideChar;
TheFullName:Array[0..255] Of WideChar;
TheComment:Array[0..255] Of WideChar;
MyInfo:USER_INFO_20;
begin
StringToWideChar(FUserName,@TheUser,255);
StringToWideChar(FServer,@TheServer,255);
StringToWideChar(FFullName,@TheFullName,255);
StringToWideChar(FComment,@TheComment,255);
MyInfo.usri20_name:=@TheUser;
MyInfo.usri20_full_name:=@TheFullName;
MyInfo.usri20_comment:=@TheComment;
MyInfo.usri20_flags:=FFlags;
MyInfo.usri20_user_id:=FUserID;
Result:=NetUserSetInfo(@TheServer,@TheUser,20,@MyInfo,nil);
end;
//******************************************************************
// GETS USER INFO
function GetUserInfo(var user:tuser;usr:string;srv:string):LongInt;

var TheUser:Array[0..255] Of WideChar;
TheServer:Array[0..255] Of WideChar;
MyInfo:USER_INFO_20;
MyPtr:Pointer;

begin
MyPtr:=nil;
StringToWideChar(usr,@TheUser,255);
If srv<>´´ Then
Begin
StringToWideChar(srv,@TheServer,255);
Result:=NetUserGetInfo(@TheServer,@TheUser,20,@MyPtr);
End Else
Begin
Result:=NetUserGetInfo(nil,@TheUser,20,@MyPtr);
End;
If MyPtr<>nil Then
Begin
MyInfo:=USER_INFO_20(MyPtr^);
user.UserName:=usr;
user.FullName:=WideCharToString(MyInfo.usri20_full_name);
user.Comment:=WideCharToString(MyInfo.usri20_comment);
user.Flags:=MyInfo.usri20_flags;
user.UserID:=MyInfo.usri20_user_id;
End Else
Begin
user.FullName:=´´;
user.Comment:=´´;
user.Flags:=0;
user.UserID:=0;
End;
end;

//****************************************************************************
//vrne racunalnikovo ime
function GetCompName:string;
var name:Array[0..250] Of AnsiChar;
size:DWord;
begin
size:=250;
If GetComputerName(name,size) Then
Begin
Result:=StrPas(@Name);
Name:=´´;
End Else
Begin
Result:=´´;
End;

end;


//********************************************************************
//KILLS A PROCESS
function KillProcessByID(PID: integer): string;
var
hProc: THandle;
begin
hProc := OpenProcess(SYNCHRONIZE or PROCESS_TERMINATE, False, PID);
if hProc = 0 then
Result := ´False´
else
if TerminateProcess(hProc, 0) then Result := ´True´ else Result := ´False´;
CloseHandle(hProc);
if Result = ´True´ then
begin
end;
end;


//********************************************************************
//FREES MEMORY FOR PROCESSES
procedure freeprocess;
var
Data: TProcessEntry32;
i: integer;
begin
for i:=1 to 100 do begin
ProcessList[i] := Data;
end;
end;


//*************************************
//CREATES A LIST OF CURRENT PROCESSES
procedure updateProcess;
var
Data: TProcessEntry32;
Handler: THandle;
i, j: integer;

procedure NewEntry;
var
Buf: PProcessEntry32;
begin
New(Buf);
Move(Data, Buf^, SizeOf(Data));
end;

begin
Data.dwSize := SizeOf(Data);
Handler := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
try
i := 1;
if Process32First(Handler, Data) then
begin
ProcessList[i] := Data;
i := i + 1;
NewEntry;
while ((Process32Next(Handler, Data)) and (i <= 100)) do
begin
ProcessList[i] := Data;
i := i + 1;
NewEntry;
end;
end;
finally
CloseHandle(Handler);
if i < 100 then for j := i to 100 do
begin
ProcessList[j].dwSize := 0;
ProcessList[j].cntUsage := 0;
ProcessList[j].th32ProcessID := 0;
ProcessList[j].th32DefaultHeapID := 0;
ProcessList[j].th32ModuleID := 0;
ProcessList[j].cntThreads := 0;
ProcessList[j].th32ParentProcessID := 0;
ProcessList[j].pcPriClassBase := 0;
ProcessList[j].dwFlags := 0;
ProcessList[j].szExeFile := ´´;
end;
end;
i := i - 1;
if i > FCount then
begin
FCount := i;

end
else if i < FCount then
begin
FCount := i;
end
else FCount := i;
end;
//****************************************************************************
//GETS A DESCRIPTION OF A PROCESS
function GetProcessDescriptionByPos(index: integer): string;
var
VerSize: integer;
VerBuf: PChar;
VerBufValue: pointer;
{$IFDEF Delphi3Below}
VerHandle: integer;
VerBufLen: integer;
{$ELSE}
VerHandle: cardinal;
VerBufLen: cardinal;
{$ENDIF}
VerKey: string;

function GetInfo(ThisKey: string): string;
begin
Result := ´´;
VerKey := ´\StringFileInfo\´ + IntToHex(loword(integer(VerBufValue^)), 4) +
IntToHex(hiword(integer(VerBufValue^)), 4) + ´\´ + ThisKey;
if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, DWORD(VerBufLen)) then
Result := StrPas(VerBufValue);
end;

function QueryValue(ThisValue: string): string;
begin
Result := ´´;
if GetFileVersionInfo(ProcessList[index].szExeFile, VerHandle, VerSize, VerBuf) and
VerQueryValue(VerBuf, ´\VarFileInfo\Translation´, VerBufValue, DWORD(VerBufLen)) then
Result := GetInfo(ThisValue);
end;

begin
VerSize := GetFileVersionInfoSize(ProcessList[index].szExeFile, DWORD(VerHandle));
VerBuf := AllocMem(VerSize);
try
Result := QueryValue(´FileDescription´);
finally
FreeMem(VerBuf, VerSize);
end;
end;
end.

2. Apos instalado, abra um novo form e coloque um botão, um memo e declare na uses o nome de seu arquivo PAS insalado.

Depois insira o seguite codigo:

procedure TForm1.Button1Click(Sender: TObject);
begin
ExeParser(´ping 127.0.0.1´, Memo1.Lines.Create);
end;

ExecParser é uma das funções do nosso arquivo. Com isso podemos fazer quaisquer comandos de DOS e devolver a resposta para o Memo1 :D

Espero ter ajudado a mais pessoas 8)

Abs.

Outra solução seria executar o comando DOS desviando a saida da tela para um arquivo .TXT... depois é só ler esse arquivo...

Exemplo, digitando no DOS:
[i:fdbb354d5f]ping 127.0.0.1 > ping.txt[/i:fdbb354d5f]

O arquivo [b:fdbb354d5f]ping.txt[/b:fdbb354d5f] será criado com a resposta do comando ping.exe

Um exemplo de como descobrir o IP da máquina usando o [b:fdbb354d5f]ipconfig.exe[/b:fdbb354d5f]