Forums.Avtograd.Ru: Вопросы по WinApi - Forums.Avtograd.Ru

Перейти к содержимому

  • (4 Страниц)
  • +
  • 1
  • 2
  • 3
  • Последняя »
  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Вопросы по WinApi

#1 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 01 Ноябрь 2007 - 18:29

Если модератор не против, то вот примеры для Delphi для WinApi. :lol:
0


  • (4 Страниц)
  • +
  • 1
  • 2
  • 3
  • Последняя »
  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

Другие ответы в этой теме

#2 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 01 Ноябрь 2007 - 21:55

Итак, начнем. Многие из вас когда-нибудь хотели бы добавить в свою программу возможность появления всплывающей системной подсказки (например как в трее у некоторых программ) - со значком, заголовком и надписью. Вот исходный код для Delphi. ;)

Для начала неплохо бы вынести загромождающую некоторую часть кода за пределы нашего проекта. Создадим текстовый файл и назовем его к примеру BallonHint.inc. Поместим в него следующий код:



const
TTS_BALLOON = $40;
TTM_SETTITLE = (WM_USER + 32);
var
hTooltip : Cardinal;
ti : TToolInfo;
hintbuffer : array[0..1023] of Char;
function CreateBaloonToolTips(hHint: HWND): Boolean;
begin
hToolTip := CreateWindowEx(WS_EX_TOOLWINDOW or WS_EX_TOPMOST, 'Tooltips_Class32', nil,
TTS_ALWAYSTIP or TTS_BALLOON, CW_USEDEFAULT, CW_USEDEFAULT, CW_USEDEFAULT,
CW_USEDEFAULT, hHint, 0, hInstance, nil);
if hToolTip <> 0 then
begin
Result := SetWindowPos(hToolTip, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE or SWP_NOACTIVATE);
ti.cbSize := SizeOf(TToolInfo);
ti.uFlags := TTF_SUBCLASS;
ti.hInst := hInstance;
end else
Result := False;
end;
function AddBaloonToolTip(hHint: HWND; IconType: Integer; Text, Title: PChar): Boolean;
var
Rect: TRect;
begin
Result := False;
if (hHint <> 0) and (GetClientRect(hHint, Rect)) then
begin
ti.hwnd := hHint;
ti.Rect := Rect;
ti.lpszText := Text;
FillChar(hintbuffer, SizeOf(hintbuffer), #0);
lstrcpy(hintbuffer, Title);
if (IconType > 3) or (IconType < 0) then IconType := 0;
SendMessage(hToolTip, TTM_SETTITLE, IconType, Integer(@hintbuffer));
Result := Boolean(SendMessage(hToolTip, TTM_ADDTOOL, 0, Integer(@ti)));
end;
end;


Сохраним наш inc файл. Далее в проекте (файл dpr) нам нужно добавить следующий код примерного вида:


procedure BallonHintsAdd;
begin
CreateBaloonToolTips(Handle);
AddBaloonToolTip(Getdlgitem(Handle, Button), 1, PChar('Всплывающая подсказка'), PChar('Заголовок'));
end;


В процедуре AddBaloonToolTip вы можете заменить число 1 на другое - 0 или 2 или 3. Тем самым вы поменяете значок в подсказке.

0 - No icon
1 - Information
2 - Warning
3 - Error

Итак, мы сделали процедуру инициализации и появления подсказок. Теперь мы должны поместить эту процедуру в секцию WM_INITDIALOG. Теперь при наведении на какой-нибудь контрол на диалоге/форме (кнопка или поле для ввода информации), возле курсора появится всплывающая подсказка. Вот и все. Прекрасный способ создания некой справочной информации для конечного пользователя. :lol:
0

#3 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 01 Ноябрь 2007 - 22:18

Продолжаем. Каждый наверное из вас когда-нибудь задумывался о том как бы сделать в своей программе заставку. Все очень просто.


unit SplashScreen;
interface
uses
Windows,
Messages;
{$R splash.res}
procedure ShowSplashScreen;
const
ClassName = 'SplashWndClass';
windowwidth: integer = 323;
windowheight: integer = 187;
windowleft: integer = 100;
windowtop: integer = 100;
bmpw = 323;
bmph = 187;
SPLASH_BITMAP = 105;
var
rt : trect;
BMP, mytimer : DWORD;
deskh, deskw : integer;
SplashWC: TWndClassEx = ( cbSize: SizeOf(TWndClassEx); style: CS_HREDRAW or CS_VREDRAW; cbClsExtra: 0; cbWndExtra: 0; hIcon: 0; lpszMenuName: nil; lpszClassName: ClassName; hIconSm: 0 );
implementation
function SplashDlgProc(hSplash: HWND; uMsg: UINT; wp: WPARAM; lp: LPARAM): LRESULT; stdcall;
var
oldBMP, dc, memdc: DWORD;
ps: TPaintStruct;
begin
Result:=0;
case uMsg of
WM_SYSCOMMAND, WM_COMMAND: Result := 0;
WM_DESTROY: PostQuitMessage(GetLastError);
WM_CREATE: mytimer := SetTimer(hSplash, SPLASH_BITMAP, 1500, nil);
WM_TIMER:
begin
KillTimer(hSplash, mytimer);
DestroyWindow(hSplash);
end;
WM_PAINT:
begin
dc := Beginpaint(hSplash, ps);
memdc := CreateCompatibleDC(dc);
oldBMP := SelectObject(memdc, BMP);
StretchBlt(dc, 0, 0, bmpw, bmph, memdc, 0, 0, bmpw, bmph, SRCCOPY);
SelectObject(memdc, oldBMP);
endpaint(hSplash, ps);
end;
else
Result := DefWindowProc(hSplash, uMsg, wp, lp);
end;
end;
procedure ShowSplashScreen;
var
x,y : Integer;
msg: TMsg;
wnd: DWORD;
begin
SplashWC.lpfnWndProc := @SplashDlgProc;
SplashWC.hInstance := hInstance;
SplashWC.hbrBackground := GetStockobject(BLACK_BRUSH);
SplashWC.hCursor := LoadCursor(hInstance, IDC_ARROW);
systemparametersinfo(SPI_GETWORKAREA, 0, @rt, 0);
deskw := 240;
deskh := 150;
RegisterClassEx(SplashWC);
BMP := LoadBitmap(hInstance, PChar(101));
wnd := CreateWindowEx(WS_EX_APPWINDOW or WS_EX_TOPMOST, ClassName, nil, WS_POPUP, windowleft, windowtop, windowwidth, windowheight, 0, 0, hInstance, nil);
x := GetSystemMetrics(SM_CXSCREEN);
y := GetSystemMetrics(SM_CYSCREEN);
MoveWindow(wnd, (x div 2) - (windowwidth div 2), (y div 2) - (windowheight div 2), windowwidth, windowheight, true);
Showwindow(wnd, SW_SHOW);
while True do begin
if not GetMessage(msg, 0, 0, 0) then break;
TranslateMessage(msg);
DispatchMessage(msg);
end;
deleteobject(BMP);
BMP := 0;
end;
end.


Подключаем этот модуль к своему проекту и далее в код приложения поместим процедуру ShowSplashScreen, которая должна отработать перед запуском основной формы или диалога. А в файле splash.res рисунок у нас находился под номером 101 и мы его загружали из ресурсов.

Вот и все. :lol:
0

#4 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 01 Ноябрь 2007 - 22:36

Продолжаем. Кто-то из вас может быть хотел использовать возможность переноса файлов из Проводника на окно своей программы.


procedure WMDropFiles(hDrop: dword);
var
L, K : dword;
DragFile : PChar;
begin
GetMem(DragFile, MAX_PATH);
K := DragQueryFile(hDrop, $FFFFFFFF, nil, 0);
for L := 0 to K - 1 do
begin
DragQueryFile(hDrop, L, DragFile, MAX_PATH);
Messagebox(Handle, PChar(DragFile), 'Сообщение', MB_ICONINFORMATION);
end;
FreeMem(DragFile);
end;


Не забудьте в коде прописать следующее:

WM_DROPFILES : WMDropFiles(Wparam);


Вот и все. :lol:
0

#5 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Ноябрь 2007 - 00:37

Пример, показывающий как можно показать и спрятать окно вашего приложения в панели задач.

Скрываем окно:


procedure HideTaskBarButton;
var
wndTemp: Integer;
begin
wndTemp := CreateWindow('STATIC', '', WS_POPUP, 0, 0, 0, 0, 0, 0, 0, nil);
ShowWindow(Handle, SW_HIDE);
SetWindowLong(Handle, GWL_HWNDPARENT, wndTemp);
ShowWindow(Handle, SW_SHOW);
end;


Показываем окно:

procedure ShowTaskBarButton;
begin
ShowWindow(Handle, SW_HIDE);
SetWindowLong(Handle, GWL_HWNDPARENT, 0);
ShowWindow(Handle, SW_SHOW);
end;


0

#6 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Ноябрь 2007 - 00:42

Пример, показывающий как можно сделать прозрачным окно вашего приложения:

Делаем прозрачность:


procedure TranspMainWinEnable;
const
cUseAlpha : array [Boolean] of Integer = (0, LWA_ALPHA);
cUseColorKey : array [Boolean] of Integer = (0, LWA_COLORKEY);
var
AStyle : Integer;
begin
AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
if (AStyle and WS_EX_LAYERED) = 0 then SetWindowLong(Handle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 0, 200, cUseAlpha[True] or cUseColorKey[False]);
end;


Убираем прозрачность:


procedure TranspMainWinDisable;
const
cUseAlpha : array [Boolean] of Integer = (0, LWA_ALPHA);
cUseColorKey : array [Boolean] of Integer = (0, LWA_COLORKEY);
var
AStyle : Integer;
begin
AStyle := GetWindowLong(Handle, GWL_EXSTYLE);
if (AStyle and WS_EX_LAYERED) = 0 then SetWindowLong(Handle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
SetLayeredWindowAttributes(Handle, 0, 255, cUseAlpha[True] or cUseColorKey[False]);
end;


0

#7 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Ноябрь 2007 - 00:46

Пример, показывающий количество использованной памяти вашей программой. Не забудьте подключить к своему проекту модуль PSAPI.


procedure GetProcessMemory;
var
pmc : PPROCESS_MEMORY_COUNTERS;
cb : Integer;
Result : String;
begin
cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
GetMem(pmc, cb);
pmc^.cb := cb;
if GetProcessMemoryInfo(GetCurrentProcess(), pmc, cb) then
Result := IntToStr(pmc^.WorkingSetSize)
else
Result := 'Нет доступа к памяти';
FreeMem(pmc);
SetDlgItemText(Handle, Static, PChar(Result))
end;


Вот и все. :lol:
0

#8 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 02 Ноябрь 2007 - 00:50

Пример, показывающий использование возможности запуска только одной копии приложения. В данном случае используются мьютексы.


unit OneCopy;
interface
function Init_Mutex(mid: string): boolean;
implementation
uses Windows;
var
mut: thandle;
function mut_id(s: string): string;
var
f: integer;
begin
result := s;
for f := 1 to length(s) do
if result[f] = '\' then
result[f] := '_';
end;
function Init_Mutex(mid: string): boolean;
begin
Mut := CreateMutex(nil, false, pchar(mut_id(mid)));
Result := not ((Mut = 0) or (GetLastError = ERROR_ALREADY_EXISTS));
end;
initialization
mut := 0;
finalization
if mut <> 0 then
CloseHandle(mut);
end.


Добавьте в свой проект этот модуль, а в коде перед запуском своей программы пропишите следующий код:


if not init_mutex(Handle) then
begin
MessageBox(0, 'Копия программы уже запущена', 'Ошибка', MB_OK or MB_IConstop);
Exit;
end;


Вот и все. :lol:
0

#9 Пользователь офлайн   DartV

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 238
  • Регистрация: 01 Ноябрь 07

Отправлено 07 Ноябрь 2007 - 00:05

А можно найти пример добавления дополнительной кнопки в верхнем правом углу формы (как в eMule кнопка Свернуть в трей)
Меня можно найти в IRC на каналах #programmers, #delphimaster, #delphiintru @ irc.tlt.ru (Dalnet.Ru), ник - Amidamaru
0

#10 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 07 Ноябрь 2007 - 00:14

Просмотр сообщенияDartV (7.11.2007, 0:05):

А можно найти пример добавления дополнительной кнопки в верхнем правом углу формы (как в eMule кнопка Свернуть в трей)

Конечно.

...

private
{ Private declarations }
procedure WMNCPAINT (var msg: Tmessage); message WM_NCPAINT;
procedure WMNCACTIVATE (var msg: Tmessage); message WM_NCACTIVATE;
procedure WMNCMOUSEDOWN (var msg: Tmessage); message WM_NCLBUTTONDOWN;
procedure WMNCMOUSEMOVE (var Msg: TMessage); message WM_NCMOUSEMOVE;
procedure WMMOUSEMOVE (var Msg: TMessage); message WM_MOUSEMOVE;
procedure WMLBUTTONUP (var msg: Tmessage); message WM_LBUTTONUP;
procedure WNCLBUTTondblclick (var msg: Tmessage); message WM_NCLBUTTONDBLCLK;
procedure WMNCRBUTTONDOWN (var msg: Tmessage); message WM_NCRBUTTONDOWN;
procedure WMNCHITTEST (var msg: Tmessage); message WM_NCHITTEST;
procedure WMSYSCOMMAND (var msg: Tmessage); message WM_SYSCOMMAND;

...

var
...
Pressed : Boolean;
FocusLost : Boolean;
Rec : TRect;
NovoMenuHandle : THandle;
PT1 : TPoint;
FHintshow : Boolean;
FHint : THintWindow;
FHintText : String;
FHintWidth : Integer;

...

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMSYSCOMMAND(var Msg: TMessage);
begin
if Msg.WParam=LongInt(NovoMenuHandle) then
//*********************************************
//Кнопка была нажата! Добавьте сюда Вашу функцию
//*********************************************
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCHITTEST(var Msg: TMessage);
var
Tmp : Boolean;
begin
if Pressed then
begin
Tmp:=FocusLost;
PT1.X := Msg.LParamLo - FrmMainForm.Left;
PT1.Y := Msg.LParamHi - FrmMainForm.Top;
if PTInRect(Rec, PT1) then
FocusLost := False
else
FocusLost := True;
if FocusLost <> Tmp then
InvalidateRect(FrmMainForm.Handle, @Rec, True);
end;
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMLBUTTONUP(var Msg: TMessage);
var
Tmp : Boolean;
begin
ReleaseCapture;
Tmp := Pressed;
Pressed := False;
if Tmp and PTInRect(Rec, PT1) then
begin
InvalidateRect(FrmMainForm.Handle, @Rec, True);
FHintShow := False;
FHint.ReleaseHandle;
//*********************************************
//Кнопка была нажата! Добавьте сюда Вашу функцию
//*********************************************
end
else
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WNCLBUTTondblclick(var Msg: TMessage);
begin
PT1.X := Msg.LParamLo - FrmMainForm.Left;
PT1.Y := Msg.LParamHi - FrmMainForm.Top;
if not PTInRect(Rec, PT1) then
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCRBUTTONDOWN(var Msg: TMessage);
begin
PT1.X := Msg.LParamLo - FrmMainForm.Left;
PT1.Y := Msg.LParamHi - FrmMainForm.Top;
if not PTInRect(Rec, PT1) then
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCMOUSEDOWN(var Msg: TMessage);
begin
PT1.X := Msg.LParamLo - FrmMainForm.Left;
PT1.Y := Msg.LParamHi - FrmMainForm.Top;
FHintShow := False;
if PTInRect(Rec, PT1) then
begin
Pressed := True;
FocusLost := False;
InvalidateRect(FrmMainForm.Handle, @Rec, True);
SetCapture(TWinControl(FrmMainForm).Handle);
end
else
begin
FrmMainForm.Paint;
inherited;
end;
end;

//------------------------------------------------------------------------------

//That function Create a Hint
procedure TFrmMainForm.WMNCMOUSEMOVE(var Msg: TMessage);
begin
PT1.X := Msg.LParamLo - FrmMainForm.Left;
PT1.Y := Msg.LParamHi - FrmMainForm.Top;
if PTInRect(Rec, PT1) then
begin
FHintWidth := FHint.Canvas.TextWidth(FHintText);
if (FHintShow = False) and (Length(Trim(FHintText)) <> 0) then
FHint.ActivateHint(
Rect(
Mouse.CursorPos.X,
Mouse.CursorPos.Y + 20,
Mouse.CursorPos.X + FHintWidth + 10,
Mouse.CursorPos.Y + 35
),
FHintText
);
FHintShow := True;
end
else
begin
FHintShow := False;
FHint.ReleaseHandle;
end;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMMOUSEMOVE(var Msg: TMessage);
begin
FHintShow := False;
FHint.ReleaseHandle;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCACTIVATE(var Msg: TMessage);
begin
InvalidateRect(FrmMainForm.Handle, @Rec, True);
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.WMNCPAINT(var Msg: TMessage);
begin
InvalidateRect(FrmMainForm.Handle, @Rec, True);
inherited;
end;

//------------------------------------------------------------------------------

procedure TFrmMainForm.FormPaint(Sender:TObject);
var
Border3D_Y, Border_Thickness, Btn_Width,
Button_Width, Button_Height : Integer;
MyCanvas : TCanvas;
begin
MyCanvas := TCanvas.Create;
MyCanvas.Handle := GetWindowDC(FrmMainForm.Handle);
Border3D_Y := GetSystemMetrics(SM_CYEDGE);
Border_Thickness:= GetSystemMetrics(SM_CYSIZEFRAME);
Button_Width := GetSystemMetrics(SM_CXSIZE);
Button_Height := GetSystemMetrics(SM_CYSIZE);

//Создаём квадратную кнопку, но если Вы захотите создать кнопку другого размера, то
//измените эту переменную на Вашу ширину.
Btn_Width := Border3D_Y + Border_Thickness + Button_Height - (2 * Border3D_Y) - 1;

Rec.Left := FrmMainForm.Width - (3 * Button_Width + Btn_Width);
Rec.Right := FrmMainForm.Width - (3 * Button_Width + 03);
Rec.Top := Border3D_Y + Border_Thickness - 1;
Rec.Bottom := Rec.Top + Button_Height - (2 * Border3D_Y);
FillRect(MyCanvas.Handle,Rec,HBRUSH(COLOR_BTNFACE+1));
If not Pressed or Focuslost Then
DrawEdge(MyCanvas.Handle, Rec, EDGE_RAISED, BF_SOFT or BF_RECT)
Else If Pressed and Not Focuslost Then
DrawEdge(MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or BF_RECT);

//It draw a the application icon to the button. Easy to change.
DrawIconEX(MyCanvas.Handle, Rec.Left+4, Rec.Top+3, Application.Icon, 8, 8, 0, 0, DI_NORMAL);

MyCanvas.Free;
end;

...

procedure TFrmMainForm.FormCreate(Sender: TObject);

...

InsertMenu(GetSystemMenu(Handle,False), 4, MF_BYPOSITION+MF_STRING, NovoMenuHandle,pchar('TEXT OF THE MENU'));
Rec := Rect(0,0,0,0);
FHintText := 'Put the text of your Hint HERE';
FHint := THintwindow.Create(Self);
FHint.Color := clInfoBk; //Вы можете изменить бэкграунд подсказки

0

#11 Пользователь офлайн   Dr.V1.3

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 116
  • Регистрация: 15 Ноябрь 07

Отправлено 12 Декабрь 2007 - 23:42

почему все примеры по винапи всегда делают на паскале?:)
с балончиками кстати понравилось, всегда думал какой класс они узают...
У меня другой вопрос...как можно обозвать поток приложения(чужого)...у т.е. чтобы как то с ним ассоцироваться, а то по IDшникам както быссмысленно, даже очередь создания потоков ничего не гоорит, некоторые потоки можно поименовать по окнам в них созданным. а что делать с остальными...думалось мне они всегда создают мьютексы или симафоры, но как оказалось фантазия у программеров бедная...
Все это нужно для диспетчера задач.
0

#12 Пользователь офлайн   DJ-Andrey-sXe

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 218
  • Регистрация: 01 Ноябрь 07

Отправлено 20 Декабрь 2007 - 15:19

Этих рецептов тонны.

Не лучше ли просто сослаться на:
http://worldcpp.vingrad.ru/
или
http://www.delphiwor...arod.ru/dw.html
?

Кому надо офф-лайн версии нахаляву, могу поделиться внутри сети.
0

#13 Пользователь офлайн   JayTee2

  • Новичок
  • Pip
  • Группа: Пользователи
  • Сообщений: 15
  • Регистрация: 01 Ноябрь 07

Отправлено 06 Январь 2008 - 17:54

Здравствуйте программисты!
мне срочно нужно научиться работать с COM портом на Visual Basic
я знач что есть какието функции WinApi но какие именно и как с ними работать незнаю
мне нужно хотябы читать с порта импульсы...
я так понял с портами работают так
1.инициализация или на порт посылается какоето число для переключения порта в режим чтения
2.чтение
3. закрытие

опишите как именно хотябы на win api функциях это реализовать?
можно в C++ но не слишком замудрённо....
ЗАРАНЕЕ ОГРОМНОЕ СПАСИБО!
0

#14 Пользователь офлайн   ifc

  • Новичок
  • Pip
  • Группа: Пользователи
  • Сообщений: 2
  • Регистрация: 14 Январь 08

Отправлено 20 Январь 2008 - 22:09

Очень интересует возможность вывода консоли cmd.exe средствами WinAPI

HWND Wnd;
char buf[1024];
Wnd = FindWindow(0, "C:\\WINDOWS\\system32\\cmd.exe");
SendMessage(Wnd, WM_CHAR, 'd' , (LPARAM)1);
SendMessage(Wnd, WM_CHAR, 'i' , (LPARAM)1);
SendMessage(Wnd, WM_CHAR, 'r' , (LPARAM)1);
SendMessage(Wnd, WM_CHAR, VK_RETURN , (LPARAM)1);
GetWindowText(Wnd,buf,1024);
MessageBoxA(NULL, buf,"test", 0);

Вместо ожидаемого результата выводится заголовок окна cmd.exe :) (C:\WINDOWS\system32\cmd.exe)

А надо вывести именно результат выполнения dir
macroheq
0

#15 Пользователь офлайн   Macro-Z

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 397
  • Регистрация: 02 Ноябрь 07

Отправлено 20 Январь 2008 - 23:42

Надо работать с пайпами, но я не знаю как ! :D
0

#16 Пользователь офлайн   musashi

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 573
  • Регистрация: 01 Ноябрь 07

Отправлено 21 Январь 2008 - 00:27

взято с DelphiWorld!

в приведенном ниже коде как раз работают с пайпами!

Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных, зачастую глючных компонент.
function ExecuteFile(FileName, StdInput: string;
  TimeOut: integer;
  var StdOutput: string): boolean;

label
  Error;

type
  TPipeHandles = (IN_WRITE, IN_READ,
    OUT_WRITE, OUT_READ,
    ERR_WRITE, ERR_READ);

type
  TPipeArray = array[TPipeHandles] of THandle;

var
  i: integer;
  ph: TPipeHandles;
  sa: TSecurityAttributes;
  Pipes: TPipeArray;
  StartInf: TStartupInfo;
  ProcInf: TProcessInformation;
  Buf: array[0..1024] of byte;
  TimeStart: TDateTime;

  function ReadOutput: string;
  var
    i: integer;
    s: string;
    BytesRead: longint;

  begin
    Result := '';
    repeat

      Buf[0] := 26;
      WriteFile(Pipes[OUT_WRITE], Buf, 1, BytesRead, nil);
      if ReadFile(Pipes[OUT_READ], Buf, 1024, BytesRead, nil) then
      begin
        if BytesRead > 0 then
        begin
          buf[BytesRead] := 0;
          s := StrPas(@Buf[0]);
          i := Pos(#26, s);
          if i > 0 then
            s := copy(s, 1, i - 1);
          Result := Result + s;
        end;
      end;

      if BytesRead1024 then
        break;
    until false;
  end;

begin
  Result := false;
  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    Pipes[ph] := INVALID_HANDLE_VALUE;

  // Создаем пайпы
  sa.nLength := sizeof(sa);
  sa.bInheritHandle := TRUE;
  sa.lpSecurityDescriptor := nil;

  if not CreatePipe(Pipes[IN_READ], Pipes[IN_WRITE], @sa, 0) then
    goto Error;
  if not CreatePipe(Pipes[OUT_READ], Pipes[OUT_WRITE], @sa, 0) then
    goto Error;
  if not CreatePipe(Pipes[ERR_READ], Pipes[ERR_WRITE], @sa, 0) then
    goto Error;

  // Пишем StdIn
  StrPCopy(@Buf[0], stdInput + ^Z);
  WriteFile(Pipes[IN_WRITE], Buf, Length(stdInput), i, nil);

  // Хендл записи в StdIn надо закрыть - иначе выполняемая программа
  // может не прочитать или прочитать не весь StdIn.

  CloseHandle(Pipes[IN_WRITE]);

  Pipes[IN_WRITE] := INVALID_HANDLE_VALUE;

  FillChar(StartInf, sizeof(TStartupInfo), 0);
  StartInf.cb := sizeof(TStartupInfo);
  StartInf.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;

  StartInf.wShowWindow := SW_SHOW; // SW_HIDE если надо запустить невидимо

  StartInf.hStdInput := Pipes[IN_READ];
  StartInf.hStdOutput := Pipes[OUT_WRITE];
  StartInf.hStdError := Pipes[ERR_WRITE];

  if not CreateProcess(nil, PChar(FileName), nil,
    nil, True, NORMAL_PRIORITY_CLASS,
    nil, nil, StartInf, ProcInf) then
    goto Error;

  TimeStart := Now;

  repeat
    Application.ProcessMessages;
    i := WaitForSingleObject(ProcInf.hProcess, 100);
    if i = WAIT_OBJECT_0 then
      break;
    if (Now - TimeStart) * SecsPerDay > TimeOut then
      break;
  until false;

  if iWAIT_OBJECT_0 then
    goto Error;
  StdOutput := ReadOutput;

  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    if Pipes[ph]INVALID_HANDLE_VALUE then
      CloseHandle(Pipes[ph]);

  CloseHandle(ProcInf.hProcess);
  CloseHandle(ProcInf.hThread);
  Result := true;
  Exit;

  Error:

  if ProcInf.hProcessINVALID_HANDLE_VALUE then

  begin
    CloseHandle(ProcInf.hThread);
    i := WaitForSingleObject(ProcInf.hProcess, 1000);
    CloseHandle(ProcInf.hProcess);
    if iWAIT_OBJECT_0 then

    begin
      ProcInf.hProcess := OpenProcess(PROCESS_TERMINATE,
        FALSE,
        ProcInf.dwProcessId);

      if ProcInf.hProcess 0 then
      begin
        TerminateProcess(ProcInf.hProcess, 0);
        CloseHandle(ProcInf.hProcess);
      end;
    end;
  end;

  for ph := Low(TPipeHandles) to High(TPipeHandles) do
    if Pipes[ph]INVALID_HANDLE_VALUE then
      CloseHandle(Pipes[ph]);

end;

0

#17 Пользователь офлайн   ifc

  • Новичок
  • Pip
  • Группа: Пользователи
  • Сообщений: 2
  • Регистрация: 14 Январь 08

Отправлено 21 Январь 2008 - 18:56

Просмотр сообщенияmusashi (21.1.2008, 0:27):

взято с DelphiWorld!

в приведенном ниже коде как раз работают с пайпами!

Это пример запуска консольных программ с передачей ей консольного ввода (как если бы он был введен с клавиатуры после запуска программы) и чтением консольного вывода. Таким способом можно запускать например стандартный виндовый ftp.exe (в невидимом окне) и тем самым отказаться от использования специализированных, зачастую глючных компонент.

Спасибо за код - только вот паскаль я не знаю :) Вобщем, как нить портирую - кто хочет помочь - не откажусь :)
macroheq
0

#18 Пользователь офлайн   TRUTHFUL

  • Пользователь
  • PipPip
  • Группа: Модераторы
  • Сообщений: 412
  • Регистрация: 01 Ноябрь 07

Отправлено 22 Январь 2008 - 01:36

Просмотр сообщенияJayTee2 (6.1.2008, 17:54):

Здравствуйте программисты!
мне срочно нужно научиться работать с COM портом на Visual Basic
я знач что есть какието функции WinApi но какие именно и как с ними работать незнаю
ЗАРАНЕЕ ОГРОМНОЕ СПАСИБО!

CreateFile описание читай. Он открывает COM, как файл. Удобно.
Истина где-то рядом... Пускай там и остается!
0

#19 Пользователь офлайн   Exception

  • Активный пользователь
  • PipPipPip
  • Группа: Пользователи
  • Сообщений: 550
  • Регистрация: 01 Ноябрь 07

Отправлено 22 Январь 2008 - 02:13

Просмотр сообщенияifc (21.1.2008, 18:56):

Спасибо за код - только вот паскаль я не знаю :) Вобщем, как нить портирую - кто хочет помочь - не откажусь :)

Самое главное правило в программировании. Чтобы не мучаться, можно поискать. Рекомендую на этих форумах:

forum.sources.ru
forum.vingrad.ru
forum.ru-board.com

На первых двух гораздо больше информации. Как раз разделы про WinApi там есть. Я бы помог, да вот только на Delphi делаю и не изменял код под другие языки программирования.
0

#20 Пользователь офлайн   Dr.V1.3

  • Пользователь
  • PipPip
  • Группа: Пользователи
  • Сообщений: 116
  • Регистрация: 15 Ноябрь 07

Отправлено 28 Январь 2008 - 13:34

Для чего нужно запускать смд и писать в нем из программы дир?
0

  • (4 Страниц)
  • +
  • 1
  • 2
  • 3
  • Последняя »
  • Вы не можете создать новую тему
  • Вы не можете ответить в тему

2 человек читают эту тему
0 пользователей, 2 гостей, 0 скрытых пользователей