Шустрый
Профиль
Группа: Участник
Сообщений: 68
Регистрация: 14.12.2007
Где: Самара
Репутация: нет
Всего: нет
|
Всем привет! Недавно загнался идеей вывода ответы на команду из cmd.exe в Memo. Нашел подходящую рабочую процедурку. но с ней форма работает через раз, и самое интересное-это происходит только при запуске из Дельфи самой.Работаю под 7. Тестил и на скомпиленом приложении....на 5 запусках....глюков не обнаружил, но всеравно опасаюсь- мало-ли. вот сама форма, может кто подскажет в чем может быть дело: | Код |
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ShellAPI, registry;
const WM_NOTIFYTRAYICON = WM_USER + 1;
type
TForm2 = class(TForm)
GroupBox1: TGroupBox;
Label1: TLabel;
Edit1: TEdit;
Edit2: TEdit;
Edit3: TEdit;
Button1: TButton;
Button2: TButton;
memo1: TMemo;
Edit4: TEdit;
Button3: TButton;
GroupBox2: TGroupBox;
Memo2: TMemo;
procedure SysInfo ;
procedure WriteLog;
//procedure check_keys;
// procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Edit2Change(Sender: TObject);
procedure Edit3Change(Sender: TObject);
procedure Edit4Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure GetFields;
private
function checkpass(var f1,f2,f3,f4:string):boolean;
public
{ Public declarations }
end;
var
Form2: TForm2;
sys_line:array[1..1] of string;
sec_key,i:integer;
field1,field2,field3,field4:string;
implementation
uses Unit1, Unit3;
{$R *.dfm}
procedure tform2.SysInfo;
label 1;
var uname,show,udomain:string;
i,keygen:integer;
array_hint:array[1..4] of integer;
begin
randomize;
array_hint[1]:=*;
array_hint[2]:=*;
array_hint[3]:=*;
array_hint[4]:=*;
//формируем для вывода в поле
for i:=1 to 4 do
begin
case array_hint[i] of
0:begin
if i>1 then
show:=show+'-***'
else show:=show+'***';
end;
1:begin
if i>1 then
show:=show+'-****'
else
show:=show+'****';
end;
2:begin
if i>1 then
show:=show+'-KPP'//my key
else
show:=show+'KPP';
end;
3:begin
keygen:=random(999999999999999999);
if i>1 then show:=show+'-'+inttostr(keygen)//random key
else
show:=show+inttostr(keygen);
end;
end;
end;
sys_line[1]:=string(show);
sec_key:=keygen;
end;
procedure TForm2.Button2Click(Sender: TObject);
begin
sysinfo;
form2.button3.visible:=true;
form2.edit1.visible:=true;
form2.memo1.enabled:=true;
form2.memo1.readonly:=false;
form2.memo1.text:=sys_line[1];
form2.memo1.readonly:=true;
form2.edit1.clear;
form2.edit2.clear;
form2.edit3.clear;
form2.edit4.clear;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
form2.memo2.readonly:=true;
form2.button1.visible:=false;
form2.button3.visible:=false;
form2.memo1.clear;
form2.memo2.clear;
form2.edit1.clear;
form2.edit2.clear;
form2.edit3.clear;
form2.edit4.clear;
form2.edit1.visible:=false;
form2.edit2.visible:=false;
form2.edit3.visible:=false;
form2.edit4.visible:=false;
end;
procedure TForm2.Edit1Change(Sender: TObject);
begin
if form2.edit1.text='' then
begin
form2.edit2.visible:=false;
form2.edit3.visible:=false;
form2.Edit4.visible:=false;
end
else
begin
form2.edit2.visible:=true;
end;
end;
procedure tform2.WriteLog;
var
log:textfile;
param:string;
begin
assignfile(log, 'log.akl');
append(log);
writeln(log,'-------begin session------');
writeln(log,formatdatetime('dd mmmm yyyy hh:mm',now));
write(log,'***: ');
writeln(log,form2.edit1.text);
write(log,'***: ');
writeln(log,form2.edit2.text);
write(log,inttostr(sec_key)+': ');
writeln(log,form2.edit3.text);
write(log,'****: ');
writeln(log,form2.edit4.text);
writeln(log,'--------end session--------');
writeln(log);
closefile(log);
end;
procedure TForm2.FormDestroy(Sender: TObject);
var
tray: TNotifyIconData;
begin
with tray do
begin
cbSize := SizeOf(TNotifyIconData);
Wnd := Form2.Handle;
uID := 1;
end;
Shell_NotifyIcon(NIM_DELETE, Addr(tray));
form2.close;
end;
procedure tform2.GetFields;
var key,tmp,fin:string;
i,k,l:integer;
begin
field1:='****';
field3:=inttostr(sec_key);
//getting other fields
check_reg:=Tregistry.create;
check_reg.rootkey:=***************;
//getting key 2
if check_reg.openkey('***********',true) then
begin
key:=check_reg.readstring('****');
l:=length(key);
delete(key,1,24); //убрали первые 24 символа
field2:=key;
key:='';
key:=check_reg.readstring('****');
field4:=key;
end;
end;
function tform2.checkpass(var f1,f2,f3,f4:string):boolean;
end;
procedure TForm2.Button1Click(Sender: TObject);
var get1,get2,get3,get4:string;
begin
writelog;
get1:=form2.edit1.text;
get2:=form2.edit2.text;
get3:=form2.edit3.text;
get4:=form2.edit4.text;
if checkpass(get1,get2,get3,get4)
then
begin
form2.memo1.clear;
form2.edit1.clear;
form2.edit2.clear;
form2.edit3.clear;
form2.edit4.clear;
form2.Hide;
form1.show;
end;
end;
procedure TForm2.Edit2Change(Sender: TObject);
begin
if form2.Edit2.text<>'' then
begin
form2.edit3.visible:=true;
end
else
begin
form2.edit3.visible:=false;
form2.Edit4.visible:=false;
end;
end;
procedure TForm2.Edit3Change(Sender: TObject);
begin
if form2.Edit3.text<>'' then
begin
form2.edit4.visible:=true;
end
else
begin
form2.Edit4.visible:=false;
end;
end;
procedure TForm2.Edit4Change(Sender: TObject);
begin
if form2.edit4.text<>'' then form2.button1.visible:=true
end;
procedure RunDosInMemo(CmdLine: string; AMemo: TMemo); <===========ТА САМАЯ ПРОЦЕДУРА=============<
const
ReadBuffer = 2400;
var
i:integer;
Security: TSecurityAttributes;
ReadPipe, WritePipe: THandle;
start: TStartUpInfo;
ProcessInfo: TProcessInformation;
Buffer: Pchar;
BytesRead: DWord;
Apprunning: DWord;
begin
Screen.Cursor := CrHourGlass;
with Security do
begin
nlength := SizeOf(TSecurityAttributes);
binherithandle := true;
lpsecuritydescriptor := nil;
end;
if Createpipe(ReadPipe, WritePipe,
@Security, 0) then
begin
Buffer := AllocMem(ReadBuffer + 1);
FillChar(Start, Sizeof(Start), #0);
start.cb := SizeOf(start);
start.hStdOutput := WritePipe;
start.hStdInput := ReadPipe;
start.dwFlags := STARTF_USESTDHANDLES +
STARTF_USESHOWWINDOW;
start.wShowWindow := SW_HIDE;
if CreateProcess(nil,
PChar(CmdLine),
@Security,
@Security,
true,
NORMAL_PRIORITY_CLASS,
nil,
nil,
start,
ProcessInfo) then
begin
repeat
Apprunning := WaitForSingleObject
(ProcessInfo.hProcess, 100);
ReadFile(ReadPipe, Buffer[0],
ReadBuffer, BytesRead, nil);
Buffer[BytesRead] := #0;
OemToAnsi(Buffer, Buffer);
AMemo.Text := AMemo.text + string(Buffer);
Application.ProcessMessages;
until (Apprunning <> WAIT_TIMEOUT);
FreeMem(Buffer);
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
CloseHandle(ReadPipe);
CloseHandle(WritePipe);
end;
Screen.Cursor := CrDefault;
end;
end;
procedure TForm2.Button3Click(Sender: TObject);
begin
form2.memo2.readonly:=false;
RunDosInMemo('cmd.exe /k set', form2.memo2); <------ОБРАЩЕНИЕ К ПРОЦЕДУРЕ
//RunDosInMemo('tasklist /fo csv',form2.memo2);
form2.memo2.readonly:=true;
end;
end.
|
|
Странное поведение у формы при выполнении процедур, Гон процедуры? 
Дата 18.12.2007, 21:02 (
Загрузка ...
