Может кто помочь? У меня такая задача - хочу в TVirtualTreeView а точнее DrawTreeView (кажись так) сделать так, чтобы занося данные в колонку (у меня она только одна) при достижении нижнего края компонента DTV не скроллинг появлялся, а новые даннные отображались в новой, второй колонке, т.е. чтобы данные отображались не в столбик а в несколько столбиков. т.е. если у меня 21 запись например, то у меня было бы не 21 строчка а 3 столбика по 7 строчек. Возможно это сделать?
» Вопросы по Delphi (все версии) - часть 3
lavren
Да в том то и дело я даже не знаю к какому хэндлу таймер применять. Думал может к контексту в том исходнике. Мне даже непонятны некоторые значения в этой функции, не то чтобы к какому-то буферу там чего-то применять... Поэтому и хочется чтобы помогли. Подозреваю что надо использовать еще WM_TIMER и в WM_INITDIALOG пихать чего-то...
Да в том то и дело я даже не знаю к какому хэндлу таймер применять. Думал может к контексту в том исходнике. Мне даже непонятны некоторые значения в этой функции, не то чтобы к какому-то буферу там чего-то применять... Поэтому и хочется чтобы помогли. Подозреваю что надо использовать еще WM_TIMER и в WM_INITDIALOG пихать чего-то...
Maks150988
Поиск рулит в интернете!
Гугл выдал:
http://www.codenet.ru/progr/delphi/WinAPI/SetTimer.php
http://sources.ru/msdn/library/using_timers.shtml
Сам нашел:
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=45719
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=25449
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=20487
Поиск рулит в интернете!
Гугл выдал: http://www.codenet.ru/progr/delphi/WinAPI/SetTimer.php
http://sources.ru/msdn/library/using_timers.shtml
Сам нашел:
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=45719
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=25449
http://www.delphikingdom.ru/asp/answer.asp?IDAnswer=20487
lavren
Спасибо. Сейчас гляну, может чего и пойму.
Добавлено:
Нет... Что-то не получилось. Как-то неудачно. Сложновато для меня.
Ладно вот еще нашел.
[more=Читать дальше..]
Первоначальный код такой:
Код: program snow;
{$R SNOW_RES.RES}
uses
Windows, Messages, ShellAPI;
const
SNOW_MOVE = 10055;
TIMER_INTERVAL = 100;
SNOW_COUNT = 25;
FLAKE_SIZE = 10;
sSnowWnd = 'SnowWnd';
sFlakeWnd = 'FlakeWnd';
var
handleWndSnow: THandle;
WndClassSnow: TWndClass;
screen_width,screen_height: Integer;
dx,xp,yp,am,stx,sty: array [0..SNOW_COUNT-1] of Double;
flakes: array [0..SNOW_COUNT-1] of THandle;
hSnowDC,hBitmapSnow,hTimerSnow: THandle;
function BitmapToRegion(hDC: THandle; oX, oY: Integer;
TransColor: COLORREF; Width,Height: Integer): HRGN;
var
TX,TY: Integer;
XStart: Integer;
Temp: HRGN;
begin
Result := 0;
for TY := 0 to Height - 1 do
begin
TX := 0;
while TX < Width do
begin
while (TX < Width) and (GetPixel(hDC,TX,TY) = TransColor) do Inc(TX);
if TX >= Width then Break;
XStart := TX;
while (TX < Width) and (GetPixel(hDC,TX,TY) <> TransColor) do Inc(TX);
if Result = 0 then
Result := CreateRectRgn(oX+XStart, oY+TY, oX+TX, oY+TY+1) else
begin
Temp := CreateRectRgn(oX+XStart, oY+TY, oX+TX, oY+TY+1);
CombineRgn(Result,Result,Temp,RGN_OR);
DeleteObject(Temp);
end;
end;
end;
end;
procedure DestroyWnd;
var
i : Integer;
begin
KillTimer(handleWndSnow,SNOW_MOVE);
for i := 0 to SNOW_COUNT-1 do DestroyWindow(flakes[i]);
DeleteDC(hSnowDC);
end;
procedure SnowMove;
var
cur_x,Index: Integer;
begin
for Index := 0 to SNOW_COUNT-1 do
begin
yp[Index] := yp[Index] + sty[Index];
if (yp[Index] > screen_height-50) then
begin
xp[Index] := random(Round(screen_width-am[Index]-30))+am[Index]/2+15;
yp[Index] := 0;
stx[Index] := 0.02+random/10;
sty[Index] := 0.7+random;
end;
dx[Index] := dx[Index]+stx[Index];
cur_x := Round(xp[Index] + am[Index] * sin(dx[Index]));
SetWindowPos(flakes[Index],HWND_TOPMOST,cur_x,Round(yp[Index]),FLAKE_SIZE,FLAKE_SIZE,SWP_SHOWWINDOW);
end;
end;
function FlakeWndProc(Window: HWND; aMessage, wParam,
lParam: LongInt): LongInt; stdcall;
var
hWndDC: THandle;
begin
case AMessage of
WM_ERASEBKGND:
begin
hWndDc := GetWindowDC(Window);
BitBlt(hWndDC,0,0,FLAKE_SIZE,FLAKE_SIZE,hSnowDC,0,0,SRCCOPY);
ReleaseDC(Window,hWndDC);
end;
WM_PAINT:
begin
Result := 1;
Exit;
end;
end;
Result := DefWindowProc(Window,aMessage,wParam,lParam);
end;
procedure TimerProc(wnd: THandle; uMsg: Integer; idEvent: Integer; dwTime: Cardinal); stdcall;
begin
SnowMove;
end;
function WindowProc(Window: HWND; aMessage, wParam,
lParam: LongInt): LongInt; stdcall;
begin
case AMessage of
WM_DESTROY: DestroyWnd;
WM_CLOSE: PostQuitMessage(0);
WM_TIMER: SnowMove;
end;
Result := DefWindowProc(Window,aMessage,wParam,lParam);
end;
procedure InitSnowFlakes;
var
i: Cardinal;
TmpRgn: HRGN;
hDC: THandle;
begin
ZeroMemory(@WndClassSnow,SizeOf(TWndClass));
with WndClassSnow do
begin
hInstance := hInstance;
lpszClassName:= sSnowWnd;
lpfnWndProc := @WindowProc;
end;
RegisterClass(WndClassSnow);
with WndClassSnow do
begin
hInstance := hInstance;
lpszClassName:= sFlakeWnd;
style := CS_OWNDC+CS_SAVEBITS;
lpfnWndProc := @FlakeWndProc;
end;
RegisterClass(WndClassSnow);
handleWndSnow := CreateWindowEx(WS_EX_TOPMOST,sSnowWnd,nil,0,0,0,200,100,0,0,hInstance,nil);
hDC := CreateDC('DISPLAY', nil, nil, nil);
hSnowDC := CreateCompatibleDC(hDC);
hBitmapSnow := LoadBitmap(hInstance,'SNOW_IMAGE');
SelectObject(hSnowDC, hBitmapSnow);
screen_width := GetDeviceCaps(hDC,HORZRES);
screen_height := GetDeviceCaps(hDC,VERTRES);
ReleaseDC(hDC,GetDesktopWindow);
Randomize;
for i := 0 to SNOW_COUNT-1 do
begin
dx[i] := 0;
am[i] := random(20);
xp[i] := random(Round(screen_width-am[i]-30))+am[i]/2+15;
yp[i] := random(screen_height);
stx[i] := 0.02 + random/10;
sty[i] := 0.7 + random;
flakes[i] := CreateWindowEx(WS_EX_TOPMOST,sFlakeWnd,nil,
WS_POPUP,0,0,FLAKE_SIZE,FLAKE_SIZE,handleWndSnow,0,hInstance,nil);
TmpRgn := BitmapToRegion(hSnowDC,0,0,0,FLAKE_SIZE,FLAKE_SIZE);
SetWindowRgn(flakes[i],TmpRgn,False);
DeleteObject(TmpRgn);
end;
hTimerSnow := SetTimer(handleWndSnow,SNOW_MOVE,TIMER_INTERVAL,nil);
end;
var
Msg: TMsg;
begin
if FindWindow(sSnowWnd,nil) = 0 then
begin
InitSnowFlakes;
while GetMessage(Msg,handleWndSnow,0,0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end.
Спасибо. Сейчас гляну, может чего и пойму.
Добавлено:
Нет... Что-то не получилось. Как-то неудачно. Сложновато для меня.
Ладно вот еще нашел.
[more=Читать дальше..]
Первоначальный код такой:
Код: program snow;
{$R SNOW_RES.RES}
uses
Windows, Messages, ShellAPI;
const
SNOW_MOVE = 10055;
TIMER_INTERVAL = 100;
SNOW_COUNT = 25;
FLAKE_SIZE = 10;
sSnowWnd = 'SnowWnd';
sFlakeWnd = 'FlakeWnd';
var
handleWndSnow: THandle;
WndClassSnow: TWndClass;
screen_width,screen_height: Integer;
dx,xp,yp,am,stx,sty: array [0..SNOW_COUNT-1] of Double;
flakes: array [0..SNOW_COUNT-1] of THandle;
hSnowDC,hBitmapSnow,hTimerSnow: THandle;
function BitmapToRegion(hDC: THandle; oX, oY: Integer;
TransColor: COLORREF; Width,Height: Integer): HRGN;
var
TX,TY: Integer;
XStart: Integer;
Temp: HRGN;
begin
Result := 0;
for TY := 0 to Height - 1 do
begin
TX := 0;
while TX < Width do
begin
while (TX < Width) and (GetPixel(hDC,TX,TY) = TransColor) do Inc(TX);
if TX >= Width then Break;
XStart := TX;
while (TX < Width) and (GetPixel(hDC,TX,TY) <> TransColor) do Inc(TX);
if Result = 0 then
Result := CreateRectRgn(oX+XStart, oY+TY, oX+TX, oY+TY+1) else
begin
Temp := CreateRectRgn(oX+XStart, oY+TY, oX+TX, oY+TY+1);
CombineRgn(Result,Result,Temp,RGN_OR);
DeleteObject(Temp);
end;
end;
end;
end;
procedure DestroyWnd;
var
i : Integer;
begin
KillTimer(handleWndSnow,SNOW_MOVE);
for i := 0 to SNOW_COUNT-1 do DestroyWindow(flakes[i]);
DeleteDC(hSnowDC);
end;
procedure SnowMove;
var
cur_x,Index: Integer;
begin
for Index := 0 to SNOW_COUNT-1 do
begin
yp[Index] := yp[Index] + sty[Index];
if (yp[Index] > screen_height-50) then
begin
xp[Index] := random(Round(screen_width-am[Index]-30))+am[Index]/2+15;
yp[Index] := 0;
stx[Index] := 0.02+random/10;
sty[Index] := 0.7+random;
end;
dx[Index] := dx[Index]+stx[Index];
cur_x := Round(xp[Index] + am[Index] * sin(dx[Index]));
SetWindowPos(flakes[Index],HWND_TOPMOST,cur_x,Round(yp[Index]),FLAKE_SIZE,FLAKE_SIZE,SWP_SHOWWINDOW);
end;
end;
function FlakeWndProc(Window: HWND; aMessage, wParam,
lParam: LongInt): LongInt; stdcall;
var
hWndDC: THandle;
begin
case AMessage of
WM_ERASEBKGND:
begin
hWndDc := GetWindowDC(Window);
BitBlt(hWndDC,0,0,FLAKE_SIZE,FLAKE_SIZE,hSnowDC,0,0,SRCCOPY);
ReleaseDC(Window,hWndDC);
end;
WM_PAINT:
begin
Result := 1;
Exit;
end;
end;
Result := DefWindowProc(Window,aMessage,wParam,lParam);
end;
procedure TimerProc(wnd: THandle; uMsg: Integer; idEvent: Integer; dwTime: Cardinal); stdcall;
begin
SnowMove;
end;
function WindowProc(Window: HWND; aMessage, wParam,
lParam: LongInt): LongInt; stdcall;
begin
case AMessage of
WM_DESTROY: DestroyWnd;
WM_CLOSE: PostQuitMessage(0);
WM_TIMER: SnowMove;
end;
Result := DefWindowProc(Window,aMessage,wParam,lParam);
end;
procedure InitSnowFlakes;
var
i: Cardinal;
TmpRgn: HRGN;
hDC: THandle;
begin
ZeroMemory(@WndClassSnow,SizeOf(TWndClass));
with WndClassSnow do
begin
hInstance := hInstance;
lpszClassName:= sSnowWnd;
lpfnWndProc := @WindowProc;
end;
RegisterClass(WndClassSnow);
with WndClassSnow do
begin
hInstance := hInstance;
lpszClassName:= sFlakeWnd;
style := CS_OWNDC+CS_SAVEBITS;
lpfnWndProc := @FlakeWndProc;
end;
RegisterClass(WndClassSnow);
handleWndSnow := CreateWindowEx(WS_EX_TOPMOST,sSnowWnd,nil,0,0,0,200,100,0,0,hInstance,nil);
hDC := CreateDC('DISPLAY', nil, nil, nil);
hSnowDC := CreateCompatibleDC(hDC);
hBitmapSnow := LoadBitmap(hInstance,'SNOW_IMAGE');
SelectObject(hSnowDC, hBitmapSnow);
screen_width := GetDeviceCaps(hDC,HORZRES);
screen_height := GetDeviceCaps(hDC,VERTRES);
ReleaseDC(hDC,GetDesktopWindow);
Randomize;
for i := 0 to SNOW_COUNT-1 do
begin
dx[i] := 0;
am[i] := random(20);
xp[i] := random(Round(screen_width-am[i]-30))+am[i]/2+15;
yp[i] := random(screen_height);
stx[i] := 0.02 + random/10;
sty[i] := 0.7 + random;
flakes[i] := CreateWindowEx(WS_EX_TOPMOST,sFlakeWnd,nil,
WS_POPUP,0,0,FLAKE_SIZE,FLAKE_SIZE,handleWndSnow,0,hInstance,nil);
TmpRgn := BitmapToRegion(hSnowDC,0,0,0,FLAKE_SIZE,FLAKE_SIZE);
SetWindowRgn(flakes[i],TmpRgn,False);
DeleteObject(TmpRgn);
end;
hTimerSnow := SetTimer(handleWndSnow,SNOW_MOVE,TIMER_INTERVAL,nil);
end;
var
Msg: TMsg;
begin
if FindWindow(sSnowWnd,nil) = 0 then
begin
InitSnowFlakes;
while GetMessage(Msg,handleWndSnow,0,0) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end;
end.
Maks150988
Сделай минимально необходимый проект, а то в твоей портянке разбираться откровенно лень.
Если компилятор считает классы не совместимыми, значит либо они не совместимы, либо необходимо произвети явное приведение типов.
А в твоем случае поможет явное указание какую из процедур RegisterClass ты хочешь использовать. Компилятор хочет использовать из classes. А ты хочешь из windows. и пока ты не объяснишь компилятору свою хотелку, он будет матюкаться.
Так что учи матчасть.
необходимо написать windows.RegisterClass(...).
на счет таймера прочитай справку. там указано что можно не использовать хендл окна. Может тебе это поможет?
Сделай минимально необходимый проект, а то в твоей портянке разбираться откровенно лень.
Если компилятор считает классы не совместимыми, значит либо они не совместимы, либо необходимо произвети явное приведение типов.
А в твоем случае поможет явное указание какую из процедур RegisterClass ты хочешь использовать. Компилятор хочет использовать из classes. А ты хочешь из windows. и пока ты не объяснишь компилятору свою хотелку, он будет матюкаться.
Так что учи матчасть.
необходимо написать windows.RegisterClass(...).
на счет таймера прочитай справку. там указано что можно не использовать хендл окна. Может тебе это поможет?
Цитата:
там указано что можно не использовать хендл окна
Этот способ описан в статях по ссылках выше!
vserd
Спасибо, получилось. Просто я не создаю окна через голый код, а гружу из ресурсов, поэтому мне до регистрации классов/окон еще каких-то.
Попробовал я и ужаснулся - ресурсов жрет немерянно... Может кто-нибудь всречал какие-нибудь эффекты на WinAPI? Хотелось бы найти эффект воды на картинке.
Спасибо, получилось. Просто я не создаю окна через голый код, а гружу из ресурсов, поэтому мне до регистрации классов/окон еще каких-то.
Попробовал я и ужаснулся - ресурсов жрет немерянно... Может кто-нибудь всречал какие-нибудь эффекты на WinAPI? Хотелось бы найти эффект воды на картинке.
Использую Delphi7, база данных сделана в Access
Формирует в Excel отчет к примеру
--------------------------------------------------------------------------------------------
N п/п Наименование СИ Тип СИ Номер СИ Место расположения
-------------------------------------------------------------------------------------------
1 ГАЗОАНАЛИЗАТОР DGE-2000 1861 101
--------------------------------------------------------------------------------------------
2 ГАЗОАНАЛИЗАТОР DGE-2000 1862 101
--------------------------------------------------------------------------------------------
3 ГАЗОАНАЛИЗАТОР ГТХ-1М 577/411 1017
--------------------------------------------------------------------------------------------
Подскажите как сделать так чтоб отчет формировался в виде
---------------------------------------------------------------------------------------------
N п/п Наименование СИ Тип СИ Номер СИ Место расположения
---------------------------------------------------------------------------------------------
101
--------------------------------------------------------------------------------------------
1 ГАЗОАНАЛИЗАТОР DGE-2000 1861 101
---------------------------------------------------------------------------------------------
2 ГАЗОАНАЛИЗАТОР DGE-2000 1862 101
--------------------------------------------------------------------------------------------
1017
---------------------------------------------------------------------------------------------
3 ГАЗОАНАЛИЗАТОР ГТХ-1М 577/411 1017
--------------------------------------------------------------------------------------------
Заранее благодарен!
Формирует в Excel отчет к примеру
--------------------------------------------------------------------------------------------
N п/п Наименование СИ Тип СИ Номер СИ Место расположения
-------------------------------------------------------------------------------------------
1 ГАЗОАНАЛИЗАТОР DGE-2000 1861 101
--------------------------------------------------------------------------------------------
2 ГАЗОАНАЛИЗАТОР DGE-2000 1862 101
--------------------------------------------------------------------------------------------
3 ГАЗОАНАЛИЗАТОР ГТХ-1М 577/411 1017
--------------------------------------------------------------------------------------------
Подскажите как сделать так чтоб отчет формировался в виде
---------------------------------------------------------------------------------------------
N п/п Наименование СИ Тип СИ Номер СИ Место расположения
---------------------------------------------------------------------------------------------
101
--------------------------------------------------------------------------------------------
1 ГАЗОАНАЛИЗАТОР DGE-2000 1861 101
---------------------------------------------------------------------------------------------
2 ГАЗОАНАЛИЗАТОР DGE-2000 1862 101
--------------------------------------------------------------------------------------------
1017
---------------------------------------------------------------------------------------------
3 ГАЗОАНАЛИЗАТОР ГТХ-1М 577/411 1017
--------------------------------------------------------------------------------------------
Заранее благодарен!
adg208
код в студию, телепатов нет)
код в студию, телепатов нет)
Примерно так
//------------------------------------------------------------------------------
//Процедура формирует в Excel основные строки СИ
procedure SiExcel(index: Integer; j: Integer; Sheet: Variant);
begin
Sheet.Rows[26].Copy(Sheet.Rows[index+1]); //Копирует 24 строку Excel в 25
Sheet.Cells[index,1]:=j; //N п/п
Sheet.Cells[index,2]:=DataModule2.TableSi.Fields.Fields[5].AsString; //Инвентарный номер
Sheet.Cells[index,3]:=DataModule2.TableSi.Fields.Fields[2].AsString; //Наименование СИ
Sheet.Cells[index,4]:=DataModule2.TableSi.Fields.Fields[3].AsString; //Тип СИ
Sheet.Cells[index,5]:=DataModule2.TableSi.Fields.Fields[4].AsString; //Номер СИ
Sheet.Cells[index,6]:=DataModule2.TableSi.Fields.Fields[16].AsString; //Место расположения
// Sheet.Cells[index,7]:=DataModule2.TableSi.Fields.Fields[11].AsString+' '+
// DataModule2.TableSi.Fields.Fields[13].AsString; //шкала
Sheet.Cells[index,7]:=DataModule2.TableSi.Fields.Fields[8].AsString+' '+
DataModule2.TableSi.Fields.Fields[10].AsString; //Предел измерения
Sheet.Cells[index,8]:=DataModule2.TableSi.Fields.Fields[19].AsFloat; //Класс точности
Sheet.Cells[index,9]:=DataModule2.TableSi.Fields.Fields[7].AsString; //Дата последнего клеймения
Sheet.Cells[index,10]:=DataModule2.TableSi.Fields.Fields[20].AsInteger; //Периодичность поверки, калибровки (месяцев)
end;
procedure TFormGrafPov.Button1Click(Sender: TObject);
var
XLApp, Sheet: Variant;
index,ind, i,j: Integer;
DMY,KS1: TDate;
KolMonth: Integer;
Y1: Word; //месяц, Y1=(год+период поверки), Y2=(год+(период поверки умноженный на два))
str,str1:String;
begin
XLApp:=CreateOleObject('Excel.Application');
XLApp.WorkBooks.Open('d:\pr\metr\db' + '\График поверки и калибровки.xls');
Sheet:=XLApp.WorkBooks[1].WorkSheets['График'];
XLApp.Visible:=true;
DataModule2.TableSi.IndexFieldNames:='KID'; //сортирует таблицу по полю KID
index:=26; //в EXCEL начинается с 26 строки
j:=1;
ind:=24;
str1:='';
DataModule2.TableSi.First;
for i:=0 to DataModule2.TableSi.RecordCount-1 do //Начало цикла
begin
//Если поле "установка/цех" есть в таблице, то выводим только строки с этой установкой/цехом
if DataModule2.TableSi.Fields.Fields[18].AsString=ComboBox.Text then
begin
//берем из таблицы ADOTableSi столбец дата последнего клеймления-"ADOTableSiDateCleim"
//преобразуем его в дату и присваиваем переменной DMY
DMY:=DataModule2.TableSi.Fields.Fields[7].AsDateTime;
//берем из таблицы ADOTableSi столбец период поверки(калибровки)-"ADOTableSiPeriodPK"
//преобразуем его в число и присваиваем переменной KolMonth
KolMonth:=StrToInt(DataModule2.TableSi.Fields.Fields[20].AsString);
//Получаем дату вычисленную из месяца последнего клеймления плюс количество месяцев периода поверки
KS1:=SummMonth(KolMonth,DMY);
//получаем год из даты KS1
Y1:=YearOf(KS1);
if Label3.Caption='' then
Label3.Caption:='0';
//Если дата последнего клеймления+ период калибровки не равны выбранным годам,
//то просто выводи пустое поле СИ
if (Y1 <> (YearOf(DateTimePicker.Date))) and (Y1<>(StrToInt(Label3.Caption))) then
begin
SiExcel(index,j,Sheet); //
Inc(index);
Inc(j);
DataModule2.TableSi.Next;
end;
end;
end;
end;
//------------------------------------------------------------------------------
//Процедура формирует в Excel основные строки СИ
procedure SiExcel(index: Integer; j: Integer; Sheet: Variant);
begin
Sheet.Rows[26].Copy(Sheet.Rows[index+1]); //Копирует 24 строку Excel в 25
Sheet.Cells[index,1]:=j; //N п/п
Sheet.Cells[index,2]:=DataModule2.TableSi.Fields.Fields[5].AsString; //Инвентарный номер
Sheet.Cells[index,3]:=DataModule2.TableSi.Fields.Fields[2].AsString; //Наименование СИ
Sheet.Cells[index,4]:=DataModule2.TableSi.Fields.Fields[3].AsString; //Тип СИ
Sheet.Cells[index,5]:=DataModule2.TableSi.Fields.Fields[4].AsString; //Номер СИ
Sheet.Cells[index,6]:=DataModule2.TableSi.Fields.Fields[16].AsString; //Место расположения
// Sheet.Cells[index,7]:=DataModule2.TableSi.Fields.Fields[11].AsString+' '+
// DataModule2.TableSi.Fields.Fields[13].AsString; //шкала
Sheet.Cells[index,7]:=DataModule2.TableSi.Fields.Fields[8].AsString+' '+
DataModule2.TableSi.Fields.Fields[10].AsString; //Предел измерения
Sheet.Cells[index,8]:=DataModule2.TableSi.Fields.Fields[19].AsFloat; //Класс точности
Sheet.Cells[index,9]:=DataModule2.TableSi.Fields.Fields[7].AsString; //Дата последнего клеймения
Sheet.Cells[index,10]:=DataModule2.TableSi.Fields.Fields[20].AsInteger; //Периодичность поверки, калибровки (месяцев)
end;
procedure TFormGrafPov.Button1Click(Sender: TObject);
var
XLApp, Sheet: Variant;
index,ind, i,j: Integer;
DMY,KS1: TDate;
KolMonth: Integer;
Y1: Word; //месяц, Y1=(год+период поверки), Y2=(год+(период поверки умноженный на два))
str,str1:String;
begin
XLApp:=CreateOleObject('Excel.Application');
XLApp.WorkBooks.Open('d:\pr\metr\db' + '\График поверки и калибровки.xls');
Sheet:=XLApp.WorkBooks[1].WorkSheets['График'];
XLApp.Visible:=true;
DataModule2.TableSi.IndexFieldNames:='KID'; //сортирует таблицу по полю KID
index:=26; //в EXCEL начинается с 26 строки
j:=1;
ind:=24;
str1:='';
DataModule2.TableSi.First;
for i:=0 to DataModule2.TableSi.RecordCount-1 do //Начало цикла
begin
//Если поле "установка/цех" есть в таблице, то выводим только строки с этой установкой/цехом
if DataModule2.TableSi.Fields.Fields[18].AsString=ComboBox.Text then
begin
//берем из таблицы ADOTableSi столбец дата последнего клеймления-"ADOTableSiDateCleim"
//преобразуем его в дату и присваиваем переменной DMY
DMY:=DataModule2.TableSi.Fields.Fields[7].AsDateTime;
//берем из таблицы ADOTableSi столбец период поверки(калибровки)-"ADOTableSiPeriodPK"
//преобразуем его в число и присваиваем переменной KolMonth
KolMonth:=StrToInt(DataModule2.TableSi.Fields.Fields[20].AsString);
//Получаем дату вычисленную из месяца последнего клеймления плюс количество месяцев периода поверки
KS1:=SummMonth(KolMonth,DMY);
//получаем год из даты KS1
Y1:=YearOf(KS1);
if Label3.Caption='' then
Label3.Caption:='0';
//Если дата последнего клеймления+ период калибровки не равны выбранным годам,
//то просто выводи пустое поле СИ
if (Y1 <> (YearOf(DateTimePicker.Date))) and (Y1<>(StrToInt(Label3.Caption))) then
begin
SiExcel(index,j,Sheet); //
Inc(index);
Inc(j);
DataModule2.TableSi.Next;
end;
end;
end;
end;
adg208
В чем проблема?
Делаешь что-то типа
select * from MyTable order by МестоРасположения
И прокатываешь по полученной выборке сверху вниз.
При смене этого МестоРасположения - выводишь его отдельной строкой, а затем - все строки выборки с этим МестоРасположения.
В чем проблема?
Делаешь что-то типа
select * from MyTable order by МестоРасположения
И прокатываешь по полученной выборке сверху вниз.
При смене этого МестоРасположения - выводишь его отдельной строкой, а затем - все строки выборки с этим МестоРасположения.
Скорее вопрос по части, что посоветуете? Задача состоит в экспорте данных в Автокад. Понятно что могут быть наработки, но что есть из того, что реально помогает? Есть ли готовые компоненты, так как выводить надо будет много всякой фигни? Интересуют даже те, которые надо покупать. Всё что знаете.
Заранее спасибо.
Заранее спасибо.
Да для меня эти вопросы сложноваты, и не надо ругаться я еше только начинающий
програмер Если не в лом как некоторым ответьте пожалуйста или подскажите где лежит
учебник именно по этим темам В поисковиках я нашел только тупые учебники в которых этих вопросов нет(((((((((((((((((((((
Вот мои вопросы:
1.Как отловить из своей программы нажатия определенных клавиш,
происходящие в окне другой программы? Именно клавиш на клавиатуре,
я не имею ввиду кнопки на чужой форме.
2.Возможно ли с помощью программы на Delphi изменить
адрес стартовой страницы Internet Explorera?
3.Как получить в своей проге список процессов которые сейчас в памяти?
4.Как эмулировать с помощью своей проги
нажатия клавиш, щелчки мыши в окне чужой программы
(то есть чтобы чужая программа думала что пользователь реально
нажимает клавиши и щелкает мышкой в её окне)
Вообще обидно - первый свой вопрос на форуме задал в отдельной теме а меня
на гугл послали И сюда вот ссылку еще кинули.... Если уж здесь не ответят
то тогда я чего-то не понял насчет Руборда
програмер Если не в лом как некоторым ответьте пожалуйста или подскажите где лежит
учебник именно по этим темам В поисковиках я нашел только тупые учебники в которых этих вопросов нет
((((((((((((((((((((( Вот мои вопросы:
1.Как отловить из своей программы нажатия определенных клавиш,
происходящие в окне другой программы? Именно клавиш на клавиатуре,
я не имею ввиду кнопки на чужой форме.
2.Возможно ли с помощью программы на Delphi изменить
адрес стартовой страницы Internet Explorera?
3.Как получить в своей проге список процессов которые сейчас в памяти?
4.Как эмулировать с помощью своей проги
нажатия клавиш, щелчки мыши в окне чужой программы
(то есть чтобы чужая программа думала что пользователь реально
нажимает клавиши и щелкает мышкой в её окне)
Вообще обидно - первый свой вопрос на форуме задал в отдельной теме а меня
на гугл послали
И сюда вот ссылку еще кинули.... Если уж здесь не ответят то тогда я чего-то не понял насчет Руборда
sunwolf13
Цитата:
В лом. Ты как начинающий, вместо того чтобы САМОМУ прочитать FAQи озадачиваешь других. Твое послание в переводе на нормальный язык: "Я не хочу читать FAQ-и, я их читать не буду и обижаюсь, если меня туда направляют. Я ХОЧУ ЧТОБЫ МНЕ ВСЕ ЧТО Я ХОЧУ УЗНАТЬ ИЗ FAQ-ов ВЫДРАЛИ И ПОКАЗАЛИ".
Многовато хочешь. Тут никто никому ничего не должен, а потому сам поработай хотя бы мышкой. delphiworld, delphimasters и т.п. тебе в руки.
Цитата:
Да для меня эти вопросы сложноваты, и не надо ругаться я еше только начинающий
програмер Если не в лом как некоторым
В лом. Ты как начинающий, вместо того чтобы САМОМУ прочитать FAQи озадачиваешь других. Твое послание в переводе на нормальный язык: "Я не хочу читать FAQ-и, я их читать не буду и обижаюсь, если меня туда направляют. Я ХОЧУ ЧТОБЫ МНЕ ВСЕ ЧТО Я ХОЧУ УЗНАТЬ ИЗ FAQ-ов ВЫДРАЛИ И ПОКАЗАЛИ".
Многовато хочешь. Тут никто никому ничего не должен, а потому сам поработай хотя бы мышкой. delphiworld, delphimasters и т.п. тебе в руки
. sunwolf13
Посмотри это...
[more]
Как эмулировать нажатия клавиш в другой программе
http://delfaq.wallst.ru/faq/emul.html
Этот модуль является почти полным аналогом мотоду SendKeys из VB.
(Автор: Ken Henderson, email:khen@compuserve.com)
================================================================
(*
SendKeys routine for 32-bit Delphi.
Written by Ken Henderson
Copyright (c) 1995 Ken Henderson email:khen@compuserve.com
This unit includes two routines that simulate popular Visual Basic
routines: Sendkeys and AppActivate. SendKeys takes a PChar
as its first parameter and a boolean as its second, like so:
SendKeys('KeyString', Wait);
where KeyString is a string of key names and modifiers that you want
to send to the current input focus and Wait is a boolean variable or value
that indicates whether SendKeys should wait for each key message to be
processed before proceeding. See the table below for more information.
AppActivate also takes a PChar as its only parameter, like so:
AppActivate('WindowName');
where WindowName is the name of the window that you want to make the
current input focus.
SendKeys supports the Visual Basic SendKeys syntax, as documented below.
Supported modifiers:
+ = Shift
^ = Control
% = Alt
Surround sequences of characters or key names with parentheses in order to
modify them as a group. For example, '+abc' shifts only 'a', while '+(abc)' shifts
all three characters.
Supported special characters
~ = Enter
( = Begin modifier group (see above)
) = End modifier group (see above)
{ = Begin key name text (see below)
} = End key name text (see below)
Supported characters:
Any character that can be typed is supported. Surround the modifier keys
listed above with braces in order to send as normal text.
Supported key names (surround these with braces):
BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP
Follow the keyname with a space and a number to send the specified key a
given number of times (e.g., {left 6}).
*)
unit sndkey32;
interface
Uses SysUtils, Windows, Messages;
function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
function AppActivate(WindowName : PChar) : boolean;
{Buffer for working with PChar's}
const
WorkBufLen = 40;
var
WorkBuf : array[0..WorkBufLen] of Char;
implementation
type
THKeys = array[0..pred(MaxLongInt)] of byte;
var
AllocationSize : integer;
(*
Converts a string of characters and key names to keyboard events and
passes them to Windows.
Example syntax:
SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);
*)
function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
type
WBytes = array[0..pred(SizeOf(Word))] of Byte;
TSendKey = record
Name : ShortString;
VKey : Byte;
end;
const
{Array of keys that SendKeys recognizes.
if you add to this list, you must be sure to keep it sorted alphabetically
by Name because a binary search routine is used to scan it.}
MaxSendKeyRecs = 41;
SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
(
(Name:'BKSP'; VKey:VK_BACK),
(Name:'BS'; VKey:VK_BACK),
(Name:'BACKSPACE'; VKey:VK_BACK),
(Name:'BREAK'; VKey:VK_CANCEL),
(Name:'CAPSLOCK'; VKey:VK_CAPITAL),
(Name:'CLEAR'; VKey:VK_CLEAR),
(Name:'DEL'; VKey:VK_DELETE),
(Name:'DELETE'; VKey:VK_DELETE),
(Name:'DOWN'; VKey:VK_DOWN),
(Name:'END'; VKey:VK_END),
(Name:'ENTER'; VKey:VK_RETURN),
(Name:'ESC'; VKey:VK_ESCAPE),
(Name:'ESCAPE'; VKey:VK_ESCAPE),
(Name:'F1'; VKey:VK_F1),
(Name:'F10'; VKey:VK_F10),
(Name:'F11'; VKey:VK_F11),
(Name:'F12'; VKey:VK_F12),
(Name:'F13'; VKey:VK_F13),
(Name:'F14'; VKey:VK_F14),
(Name:'F15'; VKey:VK_F15),
(Name:'F16'; VKey:VK_F16),
(Name:'F2'; VKey:VK_F2),
(Name:'F3'; VKey:VK_F3),
(Name:'F4'; VKey:VK_F4),
(Name:'F5'; VKey:VK_F5),
(Name:'F6'; VKey:VK_F6),
(Name:'F7'; VKey:VK_F7),
(Name:'F8'; VKey:VK_F8),
(Name:'F9'; VKey:VK_F9),
(Name:'HELP'; VKey:VK_HELP),
(Name:'HOME'; VKey:VK_HOME),
(Name:'INS'; VKey:VK_INSERT),
(Name:'LEFT'; VKey:VK_LEFT),
(Name:'NUMLOCK'; VKey:VK_NUMLOCK),
(Name:'PGDN'; VKey:VK_NEXT),
(Name:'PGUP'; VKey:VK_PRIOR),
(Name:'PRTSC'; VKey:VK_PRINT),
(Name:'RIGHT'; VKey:VK_RIGHT),
(Name:'SCROLLLOCK'; VKey:VK_SCROLL),
(Name:'TAB'; VKey:VK_TAB),
(Name:'UP'; VKey:VK_UP)
);
{Extra VK constants missing from Delphi's Windows API interface}
VK_NULL=0;
VK_SemiColon=186;
VK_Equal=187;
VK_Comma=188;
VK_Minus=189;
VK_Period=190;
VK_Slash=191;
VK_BackQuote=192;
VK_LeftBracket=219;
VK_BackSlash=220;
VK_RightBracket=221;
VK_Quote=222;
VK_Last=VK_Quote;
ExtendedVKeys : set of byte =
[VK_Up,
VK_Down,
VK_Left,
VK_Right,
VK_Home,
VK_End,
VK_Prior, {PgUp}
VK_Next, {PgDn}
VK_Insert,
VK_Delete];
const
INVALIDKEY = $FFFF;
VKKEYSCANSHIFTON = $01;
VKKEYSCANCTRLON = $02;
VKKEYSCANALTON = $04;
UNITNAME = 'SendKeys';
var
UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
PosSpace : Byte;
I, L : Integer;
NumTimes, MKey : Word;
KeyString : String[20];
procedure DisplayMessage(Message : PChar);
begin
MessageBox(0,Message,UNITNAME,0);
end;
function BitSet(BitTable, BitMask : Byte) : Boolean;
begin
Result:=ByteBool(BitTable and BitMask);
end;
procedure SetBit(var BitTable : Byte; BitMask : Byte);
begin
BitTable:=BitTable or Bitmask;
end;
procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
var
KeyboardMsg : TMsg;
begin
keybd_event(VKey, ScanCode, Flags,0);
if (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin
TranslateMessage(KeyboardMsg);
DispatchMessage(KeyboardMsg);
end;
end;
procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
Cnt : Word;
ScanCode : Byte;
NumState : Boolean;
KeyBoardState : TKeyboardState;
begin
if (VKey=VK_NUMLOCK) then begin
NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);
GetKeyBoardState(KeyBoardState);
if NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)
else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);
SetKeyBoardState(KeyBoardState);
exit;
end;
ScanCode:=Lo(MapVirtualKey(VKey,0));
For Cnt:=1 to NumTimes do
if (VKey in ExtendedVKeys)then begin
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
if (GenUpMsg) then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
end else begin
KeyboardEvent(VKey, ScanCode, 0);
if (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;
end;
procedure SendKeyUp(VKey: Byte);
var
ScanCode : Byte;
begin
ScanCode:=Lo(MapVirtualKey(VKey,0));
if (VKey in ExtendedVKeys)then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;
procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
begin
if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
end;
{Implements a simple binary search to locate special key name strings}
function StringToVKey(KeyString : ShortString) : Word;
var
Found, Collided : Boolean;
Bottom, Top, Middle : Byte;
begin
Result:=INVALIDKEY;
Bottom:=1;
Top:=MaxSendKeyRecs;
Found:=false;
Middle:=(Bottom+Top) div 2;
Repeat
Collided:=((Bottom=Middle) or (Top=Middle));
if (KeyString=SendKeyRecs[Middle].Name) then begin
Found:=true;
Result:=SendKeyRecs[Middle].VKey;
if (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
else Top:=Middle;
Middle:=(Succ(Bottom+Top)) div 2;
end;
Until (Found or Collided);
if (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');
end;
procedure PopUpShiftKeys;
begin
if (not UsingParens) then begin
if ShiftDown then SendKeyUp(VK_SHIFT);
if ControlDown then SendKeyUp(VK_CONTROL);
if AltDown then SendKeyUp(VK_MENU);
ShiftDown:=false;
ControlDown:=false;
AltDown:=false;
end;
end;
begin
AllocationSize:=MaxInt;
Result:=false;
UsingParens:=false;
ShiftDown:=false;
ControlDown:=false;
AltDown:=false;
I:=0;
L:=StrLen(SendKeysString);
if (L>AllocationSize) then L:=AllocationSize;
if (L=0) then Exit;
While (I
case SendKeysString[I] of
'(' : begin
UsingParens:=true;
Inc(I);
end;
')' : begin
UsingParens:=false;
PopUpShiftKeys;
Inc(I);
end;
'%' : begin
AltDown:=true;
SendKeyDown(VK_MENU,1,False);
Inc(I);
end;
'+' : begin
ShiftDown:=true;
SendKeyDown(VK_SHIFT,1,False);
Inc(I);
end;
'^' : begin
ControlDown:=true;
SendKeyDown(VK_CONTROL,1,False);
Inc(I);
end;
'{' : begin
NumTimes:=1;
if (SendKeysString[Succ(I)]='{') then begin
MKey:=VK_LEFTBRACKET;
SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
SendKey(MKey,1,True);
PopUpShiftKeys;
Inc(I,3);
Continue;
end;
KeyString:='';
FoundClose:=false;
While (I<=L) do begin
Inc(I);
if (SendKeysString[I]='}') then begin
FoundClose:=true;
Inc(I);
Break;
end;
KeyString:=KeyString+Upcase(SendKeysString[I]);
end;
if (Not FoundClose) then begin
DisplayMessage('No Close');
Exit;
end;
if (SendKeysString[I]='}') then begin
MKey:=VK_RIGHTBRACKET;
SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
SendKey(MKey,1,True);
PopUpShiftKeys;
Inc(I);
Continue;
end;
PosSpace:=Pos(' ',KeyString);
if (PosSpace<>0) then begin
NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
KeyString:=Copy(KeyString,1,Pred(PosSpace));
end;
if (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
else MKey:=StringToVKey(KeyString);
if (MKey<>INVALIDKEY) then begin
SendKey(MKey,NumTimes,True);
PopUpShiftKeys;
Continue;
end;
end;
'~' : begin
SendKeyDown(VK_RETURN,1,True);
PopUpShiftKeys;
Inc(I);
end;
else begin
MKey:=vkKeyScan(SendKeysString[I]);
if (MKey<>INVALIDKEY) then begin
SendKey(MKey,1,True);
PopUpShiftKeys;
end else DisplayMessage('Invalid KeyName');
Inc(I);
end;
end;
end;
Result:=true;
PopUpShiftKeys;
end;
{AppActivate
This is used to set the current input focus to a given window using its
name. This is especially useful for ensuring a window is active before
sending it input messages using the SendKeys function. You can specify
a window's name in its entirety, or only portion of it, beginning from
the left.
}
var
WindowHandle : HWND;
function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;
const
MAX_WINDOW_NAME_LEN = 80;
var
WindowName : array[0..MAX_WINDOW_NAME_LEN] of char;
begin
{Can't test GetWindowText's return value since some windows don't have a title}
GetWindowText(WHandle,WindowName,MAX_WINDOW_NAME_LEN);
Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);
if (not Result) then WindowHandle:=WHandle;
end;
function AppActivate(WindowName : PChar) : boolean;
begin
try
Result:=true;
WindowHandle:=FindWindow(nil,WindowName);
if (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Intege (PChar(WindowName)));
if (WindowHandle<>0) then begin
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
end else Result:=false;
except
on Exception do Result:=false;
end;
end;
end.
[/more]
и это...
[more]
Создание ловушек в Delphi
Previous Top Next
Автор: Chris Cummings (http://wibblovia.topcities.com)
Рано или поздно каждый программист сталкивается с таким понятим как ловушки. Чтобы приступить к ипользованию ловушек необходимо обзавестись windows SDK, который можно так же скачать с сайта Microsoft. В прилагаемом к статье архиве содержатся два проекта: hooks.dpr - это пример приложения работающего с ловушками, а hookdll.dpr - собственно сама DLL.
Что такое ловушки (Hooks)?
Проще говоря, ловушка - это функция, которая является частью DLL или часть Вашего приложения, при помощи которой можно контролировать 'происходящее' внутри окошек операционной системы. Идея состоит в том, чтобы написать функцию, которая будет вызываться каждый раз, когда будет возникать определённое событие - например, когда пользователь нажмёт клавишу или переместит мышку. Ловушки были задуманы Microsoft в первую очередь, чтобы облегчить программистам отладку приложений. Однако существует множество способов использования ловушек - например, чаще всего при помощи ловушек пишутся клавиатурные шпионы.
Итак, существует два типа ловушек - глобальные и локальные. Локальная ловушка отслеживает только те события, которые происходят только в одной программе (или потоке). Глобальная ловушка отслеживает события во всей системе (во всех потоках). Оба типа ловушек устанавливаются одинаково, однако единственно отличие заключается в том, что локальная ловушка вызывается в пределах Вашего приложения, в то время как глобальную ловушку необходимо хранить и вызывать из отдельной DLL.
Процедуры ловушки
Далее следует краткое описание каждой процедуры и структуры, необходимой для ловушки.
функция The SetWindowsHookEx
Функция SetWindowsHookEx необходима для установки ловушки. Давайте посмотрим на аргументы данной функции:
Name Type Description
idHook Integer Число, представляющее тип ловушки - например WH_KEYBOARD
lpfn TFNHookProc Адрес в памяти функции ловушки
hMod Hinst Дескриптор dll в которой находится функция. Если это локальная ловушка, то этот параметр 0.
dwThreadID Cardinal 'id потока', который Ваша программа будет контролировать. Если это глобальная ловушка, то параметр должен быть 0.
SetWindowsHookEx возвращает дескриптор (т.е. идентификатор) текущей ловушки, который можно использовать в функции UnhookWindowsHookEx для последующего удаления ловушки.
Функция hook
Функция hook это процедура, которая вызывает в случае, если необходимое нам событие происходит. Например, если установлена ловушка типа WH_KEYBOARD, то окно будет передавать в ловушку информацию о том, какая клавища была нажата. Для Вашей процедуры hook необходимы следующие аргументы:
Name Type Description
Code Integer Указывает на то, что означают следующие два параметра
wParam word Параметр размером в 1 слово (word)
lParam longword Параметр размером в 2 слова
Функция hook возвращает значение типа longword.
Функция CallNextHookEx
Данная функция предназначена для работы с цепочкой функций ловушек. Когда ловушка установлена на определённое событие, то может возникнуть такая ситуация, когда кто-нибудь тоже захочет установить ловушку на это же событие. Когда Вы устанавливаете ловушку при помощи SetWindowsHookEx, то Ваша процедура ловушки добавляется в начало списка процедур ловушек. Поэтому основная задача функции CallNextHookEx заключается в том, чтобы вызвать следующий в списке обработчик ловушки. Когда Ваша процедура ловушки завершится, то она должна вызовать CallNextHookEx, а затем вернуть заданное значение, в зависимости от типа ловушки.
Функция UnhookWindowsHookEx
Данная функция просто напросто удаляет Вашу ловушку. Единственный аргумент этой функции - это дескриптор ловушки, возвращаемы функцией SetWindowsHookEx.
Локальная ловушка
Сперва давайте создадим локальную ловушку. Необходимый для неё код содержится в 'local.pas'. При запуске Hooks.exe будет отображена небольшая форма. Для использования локальной ловушки достаточно нажать кнопку Add/Remove Local Hook на этой форме. После установки локальной ловушки, Вы заметите, что при нажатии и отпускании любой клавиши будет раздаваться звуковой сигнал (естевственно, когда hooks.exe будет иметь фокус. Ведь это локальная ловушка).
Самая первая функция в local.pas - SetupLocalHook, которая соственно и создаёт локальную ловушку, указывая на процедуру ловушки KeyboardHook. В данном случае это простой вызов SetWindowsHookEx, и, если возвращённый дескриптор > 0, указывающий на то, что процедура работает, то сохраняет этот дескриптор в CurrentHook и возвращает true, иначе будет возвращено значение false. Далее идёт функция RemoveLocalHook, которая получает в качестве параметра сохранённый дескриптор в CurrentHook и использует его в UnhookWindowsHookEx для удаления ловушки. Последняя идёт процедура hook, которая всего навсего проверяет - была ли отпущена клавиша и если надо, то выдаёт звуковой сигнал.
Глобальная ловушка
Глобальная ловушка выглядит немного сложнее. Для создания глобальной ловушки нам понадобится два проекта - певый для создания исполняемого файла и второй для создания DLL, содержащей процедуру ловушки. Глобальная ловушка, которая представлена в примере, сохраняет в файле log.txt каждые 20 нажатий клавиш. Чтобы использовать глобальную ловушку, достаточно на форме hook.exe нажать кнопку add/remove global hook. Затем, например, в записной книжке (notepad) достаточно набрать какой-нибудь текст, и Вы увидите, что в log.txt этот текст сохранится.
Наша Dll содержит две процедуры. Первая - это процедура hook, которая идентична для той, которую мы рассмотрели для локальной ловушки. Вторая процедура необходима инициализации dlls, и содержит текущий номер клавиши, которая была нажата, а также дескриптор ловушки, которая была создана.
Исполняемый файл сперва должен загрузить процедуры из DLL, а затем использовать SetWindowsHookEx, чтобы создать глобальную ловушку.
В заключении...
Представленный пример объясняет - как перехватывать события клавиатуры. Чтобы узнать, как использовать ловушки других типов, таких как WH_MOUSE, необходимо разобраться с windows SDK.
Приложения:
library HookDll;
uses
SysUtils,
Classes,windows;
var CurrentHook: HHook;
KeyArray: array[0..19] of byte;
KeyArrayPtr: integer;
CurFile: file of byte;
{
GlobalKeyboardHook
------------
This is the hook procedure to be loaded from hooks.exe when you
try and create a global hook. It is similar in structure to that defined
in hook.dpr for creating a local hook, but this time it does not beep!
Instead it stores each key pressed in an array of bytes (20 long). Whenever
this array gets full, it writes it to a file, log.txt and starts again.
}
function GlobalKeyBoardHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
begin
if code<0 then begin //if code is <0 your keyboard hook should always run CallNextHookEx instantly and
GlobalKeyBoardHook:=CallNextHookEx(CurrentHook,code,wParam,lparam); //then return the value from it.
Exit;
end;
//firstly, is the key being pressed, and is it between A and Z
//note that wParam contains the scan code of the key (which for a-z is the same as the ascii value)
if ((lParam and KF_UP)=0) and (wParam>=65) and (wParam<=90) then begin
//store the keycode in the list of keys pressed and increase the pointer
KeyArray[KeyArrayPtr]:=wParam;
KeyArrayPtr:=KeyArrayPtr+1;
//if 20 keys have been recorded, save them to log.txt and start again
if KeyArrayPtr>19 then begin
assignfile(CurFile,'log.txt');
if fileexists('log.txt')=false then rewrite(CurFile) else reset(CurFile); //if log.txt exists, add to it, otherwise recreate it
blockwrite(CurFile,KeyArray[0],20);
closefile(CurFile);
KeyArrayPtr:=0;
end;
end;
CallNextHookEx(CurrentHook,code,wParam,lparam); //call the next hook proc if there is one
GlobalKeyBoardHook:=0; //if GlobalKeyBoardHook returns a non-zero value, the window that should get
//the keyboard message doesnt get it.
Exit;
end;
{
SetHookHandle
-------------
This procedure is called by hooks.exe simply to 'inform' the dll of
the handle generated when creating the hook. This is required
if the hook procedure is to call CallNextHookEx. It also resets the
position in the key list to 0.
}
procedure SetHookHandle(HookHandle: HHook); stdcall;
begin
CurrentHook:=HookHandle;
KeyArrayPtr:=0;
end;
exports GlobalKeyBoardHook index 1,
SetHookHandle index 2;
begin
end.
unit MainFormUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Local, global,
StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.Button1Click(Sender: TObject);
begin
if GHookInstalled=true then exit; //if a global hook is installed, exit routine
//if a local hook not installed, then attempt to install one, else attempt to remove one
if HookInstalled=false then HookInstalled:=SetupLocalHook else HookInstalled:=not(RemoveLocalHook);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
HookInstalled:=false;
GHookInstalled:=false;
LibLoaded:=false;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if HookInstalled=true then RemoveLocalHook;
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
if HookInstalled=true then exit; //if a local hook is installed, exit routine
//if a local hook not installed, then attempt to install one, else attempt to remove one
//note that removelocalhook can still be used no matter whether the hook is global or local
if GHookInstalled=false then GHookInstalled:=SetupGlobalHook else GHookInstalled:=not(RemoveLocalHook);
end;
end.
[/more]
Посмотри это...
[more]
Как эмулировать нажатия клавиш в другой программе
http://delfaq.wallst.ru/faq/emul.html
Этот модуль является почти полным аналогом мотоду SendKeys из VB.
(Автор: Ken Henderson, email:khen@compuserve.com)
================================================================
(*
SendKeys routine for 32-bit Delphi.
Written by Ken Henderson
Copyright (c) 1995 Ken Henderson email:khen@compuserve.com
This unit includes two routines that simulate popular Visual Basic
routines: Sendkeys and AppActivate. SendKeys takes a PChar
as its first parameter and a boolean as its second, like so:
SendKeys('KeyString', Wait);
where KeyString is a string of key names and modifiers that you want
to send to the current input focus and Wait is a boolean variable or value
that indicates whether SendKeys should wait for each key message to be
processed before proceeding. See the table below for more information.
AppActivate also takes a PChar as its only parameter, like so:
AppActivate('WindowName');
where WindowName is the name of the window that you want to make the
current input focus.
SendKeys supports the Visual Basic SendKeys syntax, as documented below.
Supported modifiers:
+ = Shift
^ = Control
% = Alt
Surround sequences of characters or key names with parentheses in order to
modify them as a group. For example, '+abc' shifts only 'a', while '+(abc)' shifts
all three characters.
Supported special characters
~ = Enter
( = Begin modifier group (see above)
) = End modifier group (see above)
{ = Begin key name text (see below)
} = End key name text (see below)
Supported characters:
Any character that can be typed is supported. Surround the modifier keys
listed above with braces in order to send as normal text.
Supported key names (surround these with braces):
BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP
Follow the keyname with a space and a number to send the specified key a
given number of times (e.g., {left 6}).
*)
unit sndkey32;
interface
Uses SysUtils, Windows, Messages;
function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
function AppActivate(WindowName : PChar) : boolean;
{Buffer for working with PChar's}
const
WorkBufLen = 40;
var
WorkBuf : array[0..WorkBufLen] of Char;
implementation
type
THKeys = array[0..pred(MaxLongInt)] of byte;
var
AllocationSize : integer;
(*
Converts a string of characters and key names to keyboard events and
passes them to Windows.
Example syntax:
SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);
*)
function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
type
WBytes = array[0..pred(SizeOf(Word))] of Byte;
TSendKey = record
Name : ShortString;
VKey : Byte;
end;
const
{Array of keys that SendKeys recognizes.
if you add to this list, you must be sure to keep it sorted alphabetically
by Name because a binary search routine is used to scan it.}
MaxSendKeyRecs = 41;
SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
(
(Name:'BKSP'; VKey:VK_BACK),
(Name:'BS'; VKey:VK_BACK),
(Name:'BACKSPACE'; VKey:VK_BACK),
(Name:'BREAK'; VKey:VK_CANCEL),
(Name:'CAPSLOCK'; VKey:VK_CAPITAL),
(Name:'CLEAR'; VKey:VK_CLEAR),
(Name:'DEL'; VKey:VK_DELETE),
(Name:'DELETE'; VKey:VK_DELETE),
(Name:'DOWN'; VKey:VK_DOWN),
(Name:'END'; VKey:VK_END),
(Name:'ENTER'; VKey:VK_RETURN),
(Name:'ESC'; VKey:VK_ESCAPE),
(Name:'ESCAPE'; VKey:VK_ESCAPE),
(Name:'F1'; VKey:VK_F1),
(Name:'F10'; VKey:VK_F10),
(Name:'F11'; VKey:VK_F11),
(Name:'F12'; VKey:VK_F12),
(Name:'F13'; VKey:VK_F13),
(Name:'F14'; VKey:VK_F14),
(Name:'F15'; VKey:VK_F15),
(Name:'F16'; VKey:VK_F16),
(Name:'F2'; VKey:VK_F2),
(Name:'F3'; VKey:VK_F3),
(Name:'F4'; VKey:VK_F4),
(Name:'F5'; VKey:VK_F5),
(Name:'F6'; VKey:VK_F6),
(Name:'F7'; VKey:VK_F7),
(Name:'F8'; VKey:VK_F8),
(Name:'F9'; VKey:VK_F9),
(Name:'HELP'; VKey:VK_HELP),
(Name:'HOME'; VKey:VK_HOME),
(Name:'INS'; VKey:VK_INSERT),
(Name:'LEFT'; VKey:VK_LEFT),
(Name:'NUMLOCK'; VKey:VK_NUMLOCK),
(Name:'PGDN'; VKey:VK_NEXT),
(Name:'PGUP'; VKey:VK_PRIOR),
(Name:'PRTSC'; VKey:VK_PRINT),
(Name:'RIGHT'; VKey:VK_RIGHT),
(Name:'SCROLLLOCK'; VKey:VK_SCROLL),
(Name:'TAB'; VKey:VK_TAB),
(Name:'UP'; VKey:VK_UP)
);
{Extra VK constants missing from Delphi's Windows API interface}
VK_NULL=0;
VK_SemiColon=186;
VK_Equal=187;
VK_Comma=188;
VK_Minus=189;
VK_Period=190;
VK_Slash=191;
VK_BackQuote=192;
VK_LeftBracket=219;
VK_BackSlash=220;
VK_RightBracket=221;
VK_Quote=222;
VK_Last=VK_Quote;
ExtendedVKeys : set of byte =
[VK_Up,
VK_Down,
VK_Left,
VK_Right,
VK_Home,
VK_End,
VK_Prior, {PgUp}
VK_Next, {PgDn}
VK_Insert,
VK_Delete];
const
INVALIDKEY = $FFFF;
VKKEYSCANSHIFTON = $01;
VKKEYSCANCTRLON = $02;
VKKEYSCANALTON = $04;
UNITNAME = 'SendKeys';
var
UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
PosSpace : Byte;
I, L : Integer;
NumTimes, MKey : Word;
KeyString : String[20];
procedure DisplayMessage(Message : PChar);
begin
MessageBox(0,Message,UNITNAME,0);
end;
function BitSet(BitTable, BitMask : Byte) : Boolean;
begin
Result:=ByteBool(BitTable and BitMask);
end;
procedure SetBit(var BitTable : Byte; BitMask : Byte);
begin
BitTable:=BitTable or Bitmask;
end;
procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
var
KeyboardMsg : TMsg;
begin
keybd_event(VKey, ScanCode, Flags,0);
if (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin
TranslateMessage(KeyboardMsg);
DispatchMessage(KeyboardMsg);
end;
end;
procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
Cnt : Word;
ScanCode : Byte;
NumState : Boolean;
KeyBoardState : TKeyboardState;
begin
if (VKey=VK_NUMLOCK) then begin
NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);
GetKeyBoardState(KeyBoardState);
if NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)
else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);
SetKeyBoardState(KeyBoardState);
exit;
end;
ScanCode:=Lo(MapVirtualKey(VKey,0));
For Cnt:=1 to NumTimes do
if (VKey in ExtendedVKeys)then begin
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
if (GenUpMsg) then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
end else begin
KeyboardEvent(VKey, ScanCode, 0);
if (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;
end;
procedure SendKeyUp(VKey: Byte);
var
ScanCode : Byte;
begin
ScanCode:=Lo(MapVirtualKey(VKey,0));
if (VKey in ExtendedVKeys)then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;
procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
begin
if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
if (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
if (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
if (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
end;
{Implements a simple binary search to locate special key name strings}
function StringToVKey(KeyString : ShortString) : Word;
var
Found, Collided : Boolean;
Bottom, Top, Middle : Byte;
begin
Result:=INVALIDKEY;
Bottom:=1;
Top:=MaxSendKeyRecs;
Found:=false;
Middle:=(Bottom+Top) div 2;
Repeat
Collided:=((Bottom=Middle) or (Top=Middle));
if (KeyString=SendKeyRecs[Middle].Name) then begin
Found:=true;
Result:=SendKeyRecs[Middle].VKey;
if (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
else Top:=Middle;
Middle:=(Succ(Bottom+Top)) div 2;
end;
Until (Found or Collided);
if (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');
end;
procedure PopUpShiftKeys;
begin
if (not UsingParens) then begin
if ShiftDown then SendKeyUp(VK_SHIFT);
if ControlDown then SendKeyUp(VK_CONTROL);
if AltDown then SendKeyUp(VK_MENU);
ShiftDown:=false;
ControlDown:=false;
AltDown:=false;
end;
end;
begin
AllocationSize:=MaxInt;
Result:=false;
UsingParens:=false;
ShiftDown:=false;
ControlDown:=false;
AltDown:=false;
I:=0;
L:=StrLen(SendKeysString);
if (L>AllocationSize) then L:=AllocationSize;
if (L=0) then Exit;
While (I
case SendKeysString[I] of
'(' : begin
UsingParens:=true;
Inc(I);
end;
')' : begin
UsingParens:=false;
PopUpShiftKeys;
Inc(I);
end;
'%' : begin
AltDown:=true;
SendKeyDown(VK_MENU,1,False);
Inc(I);
end;
'+' : begin
ShiftDown:=true;
SendKeyDown(VK_SHIFT,1,False);
Inc(I);
end;
'^' : begin
ControlDown:=true;
SendKeyDown(VK_CONTROL,1,False);
Inc(I);
end;
'{' : begin
NumTimes:=1;
if (SendKeysString[Succ(I)]='{') then begin
MKey:=VK_LEFTBRACKET;
SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
SendKey(MKey,1,True);
PopUpShiftKeys;
Inc(I,3);
Continue;
end;
KeyString:='';
FoundClose:=false;
While (I<=L) do begin
Inc(I);
if (SendKeysString[I]='}') then begin
FoundClose:=true;
Inc(I);
Break;
end;
KeyString:=KeyString+Upcase(SendKeysString[I]);
end;
if (Not FoundClose) then begin
DisplayMessage('No Close');
Exit;
end;
if (SendKeysString[I]='}') then begin
MKey:=VK_RIGHTBRACKET;
SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
SendKey(MKey,1,True);
PopUpShiftKeys;
Inc(I);
Continue;
end;
PosSpace:=Pos(' ',KeyString);
if (PosSpace<>0) then begin
NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
KeyString:=Copy(KeyString,1,Pred(PosSpace));
end;
if (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
else MKey:=StringToVKey(KeyString);
if (MKey<>INVALIDKEY) then begin
SendKey(MKey,NumTimes,True);
PopUpShiftKeys;
Continue;
end;
end;
'~' : begin
SendKeyDown(VK_RETURN,1,True);
PopUpShiftKeys;
Inc(I);
end;
else begin
MKey:=vkKeyScan(SendKeysString[I]);
if (MKey<>INVALIDKEY) then begin
SendKey(MKey,1,True);
PopUpShiftKeys;
end else DisplayMessage('Invalid KeyName');
Inc(I);
end;
end;
end;
Result:=true;
PopUpShiftKeys;
end;
{AppActivate
This is used to set the current input focus to a given window using its
name. This is especially useful for ensuring a window is active before
sending it input messages using the SendKeys function. You can specify
a window's name in its entirety, or only portion of it, beginning from
the left.
}
var
WindowHandle : HWND;
function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;
const
MAX_WINDOW_NAME_LEN = 80;
var
WindowName : array[0..MAX_WINDOW_NAME_LEN] of char;
begin
{Can't test GetWindowText's return value since some windows don't have a title}
GetWindowText(WHandle,WindowName,MAX_WINDOW_NAME_LEN);
Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);
if (not Result) then WindowHandle:=WHandle;
end;
function AppActivate(WindowName : PChar) : boolean;
begin
try
Result:=true;
WindowHandle:=FindWindow(nil,WindowName);
if (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Intege (PChar(WindowName)));
if (WindowHandle<>0) then begin
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
end else Result:=false;
except
on Exception do Result:=false;
end;
end;
end.
[/more]
и это...
[more]
Создание ловушек в Delphi
Previous Top Next
Автор: Chris Cummings (http://wibblovia.topcities.com)
Рано или поздно каждый программист сталкивается с таким понятим как ловушки. Чтобы приступить к ипользованию ловушек необходимо обзавестись windows SDK, который можно так же скачать с сайта Microsoft. В прилагаемом к статье архиве содержатся два проекта: hooks.dpr - это пример приложения работающего с ловушками, а hookdll.dpr - собственно сама DLL.
Что такое ловушки (Hooks)?
Проще говоря, ловушка - это функция, которая является частью DLL или часть Вашего приложения, при помощи которой можно контролировать 'происходящее' внутри окошек операционной системы. Идея состоит в том, чтобы написать функцию, которая будет вызываться каждый раз, когда будет возникать определённое событие - например, когда пользователь нажмёт клавишу или переместит мышку. Ловушки были задуманы Microsoft в первую очередь, чтобы облегчить программистам отладку приложений. Однако существует множество способов использования ловушек - например, чаще всего при помощи ловушек пишутся клавиатурные шпионы.
Итак, существует два типа ловушек - глобальные и локальные. Локальная ловушка отслеживает только те события, которые происходят только в одной программе (или потоке). Глобальная ловушка отслеживает события во всей системе (во всех потоках). Оба типа ловушек устанавливаются одинаково, однако единственно отличие заключается в том, что локальная ловушка вызывается в пределах Вашего приложения, в то время как глобальную ловушку необходимо хранить и вызывать из отдельной DLL.
Процедуры ловушки
Далее следует краткое описание каждой процедуры и структуры, необходимой для ловушки.
функция The SetWindowsHookEx
Функция SetWindowsHookEx необходима для установки ловушки. Давайте посмотрим на аргументы данной функции:
Name Type Description
idHook Integer Число, представляющее тип ловушки - например WH_KEYBOARD
lpfn TFNHookProc Адрес в памяти функции ловушки
hMod Hinst Дескриптор dll в которой находится функция. Если это локальная ловушка, то этот параметр 0.
dwThreadID Cardinal 'id потока', который Ваша программа будет контролировать. Если это глобальная ловушка, то параметр должен быть 0.
SetWindowsHookEx возвращает дескриптор (т.е. идентификатор) текущей ловушки, который можно использовать в функции UnhookWindowsHookEx для последующего удаления ловушки.
Функция hook
Функция hook это процедура, которая вызывает в случае, если необходимое нам событие происходит. Например, если установлена ловушка типа WH_KEYBOARD, то окно будет передавать в ловушку информацию о том, какая клавища была нажата. Для Вашей процедуры hook необходимы следующие аргументы:
Name Type Description
Code Integer Указывает на то, что означают следующие два параметра
wParam word Параметр размером в 1 слово (word)
lParam longword Параметр размером в 2 слова
Функция hook возвращает значение типа longword.
Функция CallNextHookEx
Данная функция предназначена для работы с цепочкой функций ловушек. Когда ловушка установлена на определённое событие, то может возникнуть такая ситуация, когда кто-нибудь тоже захочет установить ловушку на это же событие. Когда Вы устанавливаете ловушку при помощи SetWindowsHookEx, то Ваша процедура ловушки добавляется в начало списка процедур ловушек. Поэтому основная задача функции CallNextHookEx заключается в том, чтобы вызвать следующий в списке обработчик ловушки. Когда Ваша процедура ловушки завершится, то она должна вызовать CallNextHookEx, а затем вернуть заданное значение, в зависимости от типа ловушки.
Функция UnhookWindowsHookEx
Данная функция просто напросто удаляет Вашу ловушку. Единственный аргумент этой функции - это дескриптор ловушки, возвращаемы функцией SetWindowsHookEx.
Локальная ловушка
Сперва давайте создадим локальную ловушку. Необходимый для неё код содержится в 'local.pas'. При запуске Hooks.exe будет отображена небольшая форма. Для использования локальной ловушки достаточно нажать кнопку Add/Remove Local Hook на этой форме. После установки локальной ловушки, Вы заметите, что при нажатии и отпускании любой клавиши будет раздаваться звуковой сигнал (естевственно, когда hooks.exe будет иметь фокус. Ведь это локальная ловушка).
Самая первая функция в local.pas - SetupLocalHook, которая соственно и создаёт локальную ловушку, указывая на процедуру ловушки KeyboardHook. В данном случае это простой вызов SetWindowsHookEx, и, если возвращённый дескриптор > 0, указывающий на то, что процедура работает, то сохраняет этот дескриптор в CurrentHook и возвращает true, иначе будет возвращено значение false. Далее идёт функция RemoveLocalHook, которая получает в качестве параметра сохранённый дескриптор в CurrentHook и использует его в UnhookWindowsHookEx для удаления ловушки. Последняя идёт процедура hook, которая всего навсего проверяет - была ли отпущена клавиша и если надо, то выдаёт звуковой сигнал.
Глобальная ловушка
Глобальная ловушка выглядит немного сложнее. Для создания глобальной ловушки нам понадобится два проекта - певый для создания исполняемого файла и второй для создания DLL, содержащей процедуру ловушки. Глобальная ловушка, которая представлена в примере, сохраняет в файле log.txt каждые 20 нажатий клавиш. Чтобы использовать глобальную ловушку, достаточно на форме hook.exe нажать кнопку add/remove global hook. Затем, например, в записной книжке (notepad) достаточно набрать какой-нибудь текст, и Вы увидите, что в log.txt этот текст сохранится.
Наша Dll содержит две процедуры. Первая - это процедура hook, которая идентична для той, которую мы рассмотрели для локальной ловушки. Вторая процедура необходима инициализации dlls, и содержит текущий номер клавиши, которая была нажата, а также дескриптор ловушки, которая была создана.
Исполняемый файл сперва должен загрузить процедуры из DLL, а затем использовать SetWindowsHookEx, чтобы создать глобальную ловушку.
В заключении...
Представленный пример объясняет - как перехватывать события клавиатуры. Чтобы узнать, как использовать ловушки других типов, таких как WH_MOUSE, необходимо разобраться с windows SDK.
Приложения:
library HookDll;
uses
SysUtils,
Classes,windows;
var CurrentHook: HHook;
KeyArray: array[0..19] of byte;
KeyArrayPtr: integer;
CurFile: file of byte;
{
GlobalKeyboardHook
------------
This is the hook procedure to be loaded from hooks.exe when you
try and create a global hook. It is similar in structure to that defined
in hook.dpr for creating a local hook, but this time it does not beep!
Instead it stores each key pressed in an array of bytes (20 long). Whenever
this array gets full, it writes it to a file, log.txt and starts again.
}
function GlobalKeyBoardHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
begin
if code<0 then begin //if code is <0 your keyboard hook should always run CallNextHookEx instantly and
GlobalKeyBoardHook:=CallNextHookEx(CurrentHook,code,wParam,lparam); //then return the value from it.
Exit;
end;
//firstly, is the key being pressed, and is it between A and Z
//note that wParam contains the scan code of the key (which for a-z is the same as the ascii value)
if ((lParam and KF_UP)=0) and (wParam>=65) and (wParam<=90) then begin
//store the keycode in the list of keys pressed and increase the pointer
KeyArray[KeyArrayPtr]:=wParam;
KeyArrayPtr:=KeyArrayPtr+1;
//if 20 keys have been recorded, save them to log.txt and start again
if KeyArrayPtr>19 then begin
assignfile(CurFile,'log.txt');
if fileexists('log.txt')=false then rewrite(CurFile) else reset(CurFile); //if log.txt exists, add to it, otherwise recreate it
blockwrite(CurFile,KeyArray[0],20);
closefile(CurFile);
KeyArrayPtr:=0;
end;
end;
CallNextHookEx(CurrentHook,code,wParam,lparam); //call the next hook proc if there is one
GlobalKeyBoardHook:=0; //if GlobalKeyBoardHook returns a non-zero value, the window that should get
//the keyboard message doesnt get it.
Exit;
end;
{
SetHookHandle
-------------
This procedure is called by hooks.exe simply to 'inform' the dll of
the handle generated when creating the hook. This is required
if the hook procedure is to call CallNextHookEx. It also resets the
position in the key list to 0.
}
procedure SetHookHandle(HookHandle: HHook); stdcall;
begin
CurrentHook:=HookHandle;
KeyArrayPtr:=0;
end;
exports GlobalKeyBoardHook index 1,
SetHookHandle index 2;
begin
end.
unit MainFormUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Local, global,
StdCtrls;
type
TMainForm = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.Button1Click(Sender: TObject);
begin
if GHookInstalled=true then exit; //if a global hook is installed, exit routine
//if a local hook not installed, then attempt to install one, else attempt to remove one
if HookInstalled=false then HookInstalled:=SetupLocalHook else HookInstalled:=not(RemoveLocalHook);
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
HookInstalled:=false;
GHookInstalled:=false;
LibLoaded:=false;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
if HookInstalled=true then RemoveLocalHook;
end;
procedure TMainForm.Button2Click(Sender: TObject);
begin
if HookInstalled=true then exit; //if a local hook is installed, exit routine
//if a local hook not installed, then attempt to install one, else attempt to remove one
//note that removelocalhook can still be used no matter whether the hook is global or local
if GHookInstalled=false then GHookInstalled:=SetupGlobalHook else GHookInstalled:=not(RemoveLocalHook);
end;
end.
[/more]
sunwolf13
полностью поддерживаю SergeBS - в книжках по дельфи подобное искать вряд ли получится,а вот FAQ-ов с ответами на подобные вопросы - пруд пруди...
Цитата:
delphiworld - это более 5000 статей, с поисковой системой...
ссылка - http://delphiworld.narod.ru/dw.html
полностью поддерживаю SergeBS - в книжках по дельфи подобное искать вряд ли получится,а вот FAQ-ов с ответами на подобные вопросы - пруд пруди...
Цитата:
delphiworld, delphimasters и т.п.
delphiworld - это более 5000 статей, с поисковой системой...
ссылка - http://delphiworld.narod.ru/dw.html
Не могу понять в чем загвоздка. Суть программы такова, чтобы, используя TidFTP, копировать список файлов указанных в Memo в директорию указанную в ePathtoCopy. Директории может и не быть, поэтому если что мне нужно ее создать. Вот и написал такую маленькую функцию CahngeFullDir. Все вроде бы нормально, исполняется и выполняется, но только один раз после запуска приложения. Когда я нажимаю второй раз на эту же кнопу, то в строчке "Вот здесь" , выдается ошибка причем почему-то разные ошибки то Acces violation at adress xxxxx то EPrivelege и что-то по поводу привелегий (сейчас уже не могу добиться ее отображения)
одно меня мучает, не могу понять, я ведь не зря уже разделил целевую строчку директории на две, в два захода чтобы дошло до нужно директории, а он проходит первое использование CahngeFullDir (полностью) и при втором заходе выдает ошибку на той строчке после 1го прохода ее рекурсивно.... и даже после этой ошибки, я еще раз нажимаю кнопку и опять повторяется тоже самое - первый раз CahngeFullDir проходит нормально а второй раз нет
Не могу понять... в чем же может быть дело подскажете?
[more]
Код: procedure TForm1.btnConnectClick(Sender: TObject);
var
i:integer;
procedure CahngeFullDir(Dest:string);
var str1:TStrings;
i:integer;
s:string;
begin
str1:=TStringList.Create;
if str1=nil then ShowMessage('НЕ создан str1');
Dest:=RightStr(Dest,length(Dest)-1);
i:=AnsiPos('/',Dest);
if i>0 then begin
s:=LeftStr(Dest,i-1);
Dest:=RightStr(Dest,Length(Dest)-i);
idportal.List(str1,'*',false) <================== "Вот здесь"
if str1.IndexOf(s)>=0 then else
idportal.MakeDir(s);
idportal.ChangeDir(s);
i:=AnsiPos('/',Dest);
if i>0 then CahngeFullDir('/'+Dest)
else if length(Dest)>1 then
CahngeFullDir('/'+Dest+'/');
//idportal.List(nil);
end;
str1.Free;
end;
procedure PutFile(FileName:string);
begin
idportal.TransferMode(dmStream);
try
FStream:=TFileStream.Create(FileName,fmOpenRead or fmShareExclusive);
idportal.Put(FStream,ExtractFileName(FileName));
finally
FStream.Free;
end;
end;
begin
if Assigned(idportal) then begin
idportal.Free;
idportal:=TIdFTP.Create(nil);
idportal.OnWork:=Form1.idportalWork;
end;
If idportal.Connected then
Begin
idportal.Abort;
idportal.Quit;
End;
idportal.Host:='192.168.0.130';
idportal.Username:='httpadmin';
idportal.Password:='12345678';
idportal.ProxySettings.Host:='';
idportal.ProxySettings.Port:=0;
idportal.Passive := false;
idportal.Connect;
If idportal.Connected then
Begin
idportal.ChangeDir('/');
CahngeFullDir('/var/www/html');
CahngeFullDir(ePathtoCopy.Text);
for i:=0 to Memo1.Lines.Count-1 do
if FileExists(Memo1.Lines[i]) then
PutFile(Memo1.Lines[i]);
idportal.Abort;
idportal.Quit;
ShowMessage('Передача данных закончилась');
End;
If idportal.Connected then
Begin
idportal.Abort;
idportal.Quit;
End;
end;
одно меня мучает, не могу понять, я ведь не зря уже разделил целевую строчку директории на две, в два захода чтобы дошло до нужно директории, а он проходит первое использование CahngeFullDir (полностью) и при втором заходе выдает ошибку на той строчке после 1го прохода ее рекурсивно.... и даже после этой ошибки, я еще раз нажимаю кнопку и опять повторяется тоже самое - первый раз CahngeFullDir проходит нормально а второй раз нет
Не могу понять... в чем же может быть дело подскажете?
[more]
Код: procedure TForm1.btnConnectClick(Sender: TObject);
var
i:integer;
procedure CahngeFullDir(Dest:string);
var str1:TStrings;
i:integer;
s:string;
begin
str1:=TStringList.Create;
if str1=nil then ShowMessage('НЕ создан str1');
Dest:=RightStr(Dest,length(Dest)-1);
i:=AnsiPos('/',Dest);
if i>0 then begin
s:=LeftStr(Dest,i-1);
Dest:=RightStr(Dest,Length(Dest)-i);
idportal.List(str1,'*',false) <================== "Вот здесь"
if str1.IndexOf(s)>=0 then else
idportal.MakeDir(s);
idportal.ChangeDir(s);
i:=AnsiPos('/',Dest);
if i>0 then CahngeFullDir('/'+Dest)
else if length(Dest)>1 then
CahngeFullDir('/'+Dest+'/');
//idportal.List(nil);
end;
str1.Free;
end;
procedure PutFile(FileName:string);
begin
idportal.TransferMode(dmStream);
try
FStream:=TFileStream.Create(FileName,fmOpenRead or fmShareExclusive);
idportal.Put(FStream,ExtractFileName(FileName));
finally
FStream.Free;
end;
end;
begin
if Assigned(idportal) then begin
idportal.Free;
idportal:=TIdFTP.Create(nil);
idportal.OnWork:=Form1.idportalWork;
end;
If idportal.Connected then
Begin
idportal.Abort;
idportal.Quit;
End;
idportal.Host:='192.168.0.130';
idportal.Username:='httpadmin';
idportal.Password:='12345678';
idportal.ProxySettings.Host:='';
idportal.ProxySettings.Port:=0;
idportal.Passive := false;
idportal.Connect;
If idportal.Connected then
Begin
idportal.ChangeDir('/');
CahngeFullDir('/var/www/html');
CahngeFullDir(ePathtoCopy.Text);
for i:=0 to Memo1.Lines.Count-1 do
if FileExists(Memo1.Lines[i]) then
PutFile(Memo1.Lines[i]);
idportal.Abort;
idportal.Quit;
ShowMessage('Передача данных закончилась');
End;
If idportal.Connected then
Begin
idportal.Abort;
idportal.Quit;
End;
end;
TankMan
Есть функция ForceDirectories - сама создаст нужную тебе цепочку вложенных папок.
ЗЫ. Если спрашиваешь про создание папок - приведи неработающий код с созданием, не надо кидать листинг всей программы, не нужен он никому, да и тег more никто не отменял
Есть функция ForceDirectories - сама создаст нужную тебе цепочку вложенных папок.
ЗЫ. Если спрашиваешь про создание папок - приведи неработающий код с созданием, не надо кидать листинг всей программы, не нужен он никому, да и тег more никто не отменял
RomanTim
Я редко сюда пишу, вот и не знал про тег more ...
И про ForceDirectories я тоже не знал.. вечером попробую заранее спасибо.
... а так, на будущее, может кто знает, в чем ошибка?
Я редко сюда пишу, вот и не знал про тег more ...
И про ForceDirectories я тоже не знал
.. вечером попробую заранее спасибо. ... а так, на будущее, может кто знает, в чем ошибка?
Решил покрасить диалог и статики на нем в белый цвет. Но вот беда - не знаю как поменять стандартный цвет меню... Подскажите что можно сделать. Меню упомянул в ресурсе диалога. Диалог смотрится хорошо, а вот с цветом полосы меню проблема. Он стандартный 3dface...
И еще вопрос. Решил для себя сделать программку для определения размера файла через урл ссылки. Использовал тот самый пример:
Код:
function GetUrlInfo(const dwInfoLevel: DWORD; const FileURL: string):
string;
var
hSession, hFile: hInternet;
dwBuffer: Pointer;
dwBufferLen, dwIndex: DWORD;
begin
Result := '';
hSession := InternetOpen('STEROID Download',
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hSession) then begin
hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,
INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwBufferLen := 40;
if HttpQueryInfo(hFile, dwInfoLevel, @dwBuffer, dwBufferLen, dwIndex)
then Result := PChar(@dwBuffer);
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
GetUrlInfo(HTTP_QUERY_CONTENT_LENGTH, 'http://files.ru/files.zip');
Код:
function GetUrlInfo(const dwInfoLevel: DWORD; const FileURL: string):
string;
var
hSession, hFile: hInternet;
dwBuffer: Pointer;
dwBufferLen, dwIndex: DWORD;
begin
Result := '';
hSession := InternetOpen('STEROID Download',
INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if Assigned(hSession) then begin
hFile := InternetOpenURL(hSession, PChar(FileURL), nil, 0,
INTERNET_FLAG_RELOAD, 0);
dwIndex := 0;
dwBufferLen := 40;
if HttpQueryInfo(hFile, dwInfoLevel, @dwBuffer, dwBufferLen, dwIndex)
then Result := PChar(@dwBuffer);
if Assigned(hFile) then InternetCloseHandle(hFile);
InternetCloseHandle(hsession);
end;
end;
GetUrlInfo(HTTP_QUERY_CONTENT_LENGTH, 'http://files.ru/files.zip');
delover автокад поддерживает OLE-автоматизацию,и даже имеет встроенный VBA. Так что "экспортировать" туда не сложнее чем в эксель, если знаешь объектную модель. Все примеры идут в комплекте.
TankMan
Вчера неправильно понял где ты папки создавать собираешься, на FTP ForceDirectories разумеется работать не будет.
Посмотрел твой ChangeFullDir - падать он у меня на FTP от IIS не стал, но не работал. Поэтому переписал в [more=такой вид] procedure CahngeFullDir(Dest: string);
var
str1: TStrings;
i: Integer;
s: string;
begin
// если слэш в начале строки - идем в корневой каталог,
// на следующих шагах рекурсии он уже не появится,
// если слэша нет - пляшем от текущего каталога
if Dest[1] = '/' then begin
idportal.ChangeDir('/');
Delete(Dest, 1, 1);
end;
i := AnsiPos('/', Dest);
if i > 0 then begin
s := Copy(Dest, 1, i - 1);
Delete(Dest, 1, i);
end else begin
s := Dest;
Dest := '';
end;
str1 := TStringList.Create;
// на IIS все - не звездочка, а пустая строка
idportal.List(str1, '', False);
if str1.IndexOf(s) < 0 then
idportal.MakeDir(s);
str1.Free;
idportal.ChangeDir(s);
if Dest <> '' then
CahngeFullDir(Dest);
end;[/more]
Вчера неправильно понял где ты папки создавать собираешься, на FTP ForceDirectories разумеется работать не будет.
Посмотрел твой ChangeFullDir - падать он у меня на FTP от IIS не стал, но не работал. Поэтому переписал в [more=такой вид] procedure CahngeFullDir(Dest: string);
var
str1: TStrings;
i: Integer;
s: string;
begin
// если слэш в начале строки - идем в корневой каталог,
// на следующих шагах рекурсии он уже не появится,
// если слэша нет - пляшем от текущего каталога
if Dest[1] = '/' then begin
idportal.ChangeDir('/');
Delete(Dest, 1, 1);
end;
i := AnsiPos('/', Dest);
if i > 0 then begin
s := Copy(Dest, 1, i - 1);
Delete(Dest, 1, i);
end else begin
s := Dest;
Dest := '';
end;
str1 := TStringList.Create;
// на IIS все - не звездочка, а пустая строка
idportal.List(str1, '', False);
if str1.IndexOf(s) < 0 then
idportal.MakeDir(s);
str1.Free;
idportal.ChangeDir(s);
if Dest <> '' then
CahngeFullDir(Dest);
end;[/more]
Мдааа... написано конечно более "разумно" чем у меня, но суть та же к сожалению у меня и результат тот же - Access violation at address 00AE7137 может компонент инди у меня старый? не подскажете, где обновить можно?
Добавлено:
Ведь в первый раз у меня все нормально проходит, да сколько угодно раз может проходить эта функция, но только после перезапуска приложения...
- Access violation at address 00AE7137 может компонент инди у меня старый? не подскажете, где обновить можно? Добавлено:
Ведь в первый раз у меня все нормально проходит, да сколько угодно раз может проходить эта функция, но только после перезапуска приложения
...... мда.. вот я и выяснил в чем дело, оказалось всетаки нужно было весь код выкладывать
Код:
procedure TForm1.idportalWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
if Assigned(FStream) then
begin
ProgressBar1.Max:=FStream.Size;
ProgressBar1.Position:=FStream.Position;
end;
end;
Код:
procedure TForm1.idportalWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
if Assigned(FStream) then
begin
ProgressBar1.Max:=FStream.Size;
ProgressBar1.Position:=FStream.Position;
end;
end;
jONES1979
Спасибо большое. Это многое решает. Если это OLE-автоматизация, то я точно разберусь. Просто решал - брать заказ или нет. Сейчас думаю, что это реально.
Спасибо большое. Это многое решает. Если это OLE-автоматизация, то я точно разберусь. Просто решал - брать заказ или нет. Сейчас думаю, что это реально.
TankMan
Assigned - это просто проверка на nil, поэтому или делай
FStream.Free;
FStream := nil;
или
FreeAndNil(FStream);
Assigned - это просто проверка на nil, поэтому или делай
FStream.Free;
FStream := nil;
или
FreeAndNil(FStream);
Может кому и пригодится примерчик создания программы на WinApi, которая определяет размер файла по URL ссылке. Сделал по тупости за несколько минут... Строго не судите...
[more=Читать дальше..]
Код: 101 DIALOGEX 0, 0, 185, 85
STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU
CAPTION "GetUrlSize"
LANGUAGE LANG_RUSSIAN, 0x1
FONT 8, "TAHOMA"
{
CONTROL "", 1001, STATIC, SS_LEFT | WS_CHILD | WS_VISIBLE | WS_GROUP, 0, 0, 185, 30
CONTROL 101, 1002, STATIC, SS_ICON | SS_REALSIZEIMAGE | WS_CHILD | WS_VISIBLE, 7, 7, 21, 20
CONTROL "GetUrlSize v1.0", 1003, STATIC, SS_CENTER | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 35, 10, 145, 10
CONTROL "", -1, STATIC, SS_ETCHEDHORZ | WS_CHILD | WS_VISIBLE, 0, 30, 187, 1
CONTROL "URL Адрес", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 5, 37, 35, 7
CONTROL ":", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 45, 37, 8, 8
CONTROL "", 1005, EDIT, ES_LEFT | ES_AUTOHSCROLL | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 55, 35, 125, 12
CONTROL "Размер", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 5, 52, 35, 8
CONTROL ":", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 45, 52, 8, 8
CONTROL "", 1006, EDIT, ES_CENTER | ES_AUTOHSCROLL | ES_READONLY | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 55, 50, 60, 12
CONTROL "байт", 0, STATIC, SS_CENTER | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 120, 52, 20, 8
CONTROL ">", 1007, BUTTON, BS_DEFPUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 145, 50, 15, 12
CONTROL "!", 1008, BUTTON, BS_AUTOCHECKBOX | BS_PUSHLIKE | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 165, 50, 15, 12
CONTROL "Результат", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 5, 67, 35, 8
CONTROL ":", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 45, 67, 8, 8
CONTROL "", 1009, EDIT, ES_CENTER | ES_AUTOHSCROLL | ES_READONLY | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 55, 65, 125, 12
}
[more=Читать дальше..]
Код: 101 DIALOGEX 0, 0, 185, 85
STYLE DS_MODALFRAME | DS_CENTER | WS_POPUP | WS_CAPTION | WS_SYSMENU
CAPTION "GetUrlSize"
LANGUAGE LANG_RUSSIAN, 0x1
FONT 8, "TAHOMA"
{
CONTROL "", 1001, STATIC, SS_LEFT | WS_CHILD | WS_VISIBLE | WS_GROUP, 0, 0, 185, 30
CONTROL 101, 1002, STATIC, SS_ICON | SS_REALSIZEIMAGE | WS_CHILD | WS_VISIBLE, 7, 7, 21, 20
CONTROL "GetUrlSize v1.0", 1003, STATIC, SS_CENTER | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 35, 10, 145, 10
CONTROL "", -1, STATIC, SS_ETCHEDHORZ | WS_CHILD | WS_VISIBLE, 0, 30, 187, 1
CONTROL "URL Адрес", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 5, 37, 35, 7
CONTROL ":", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 45, 37, 8, 8
CONTROL "", 1005, EDIT, ES_LEFT | ES_AUTOHSCROLL | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 55, 35, 125, 12
CONTROL "Размер", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 5, 52, 35, 8
CONTROL ":", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 45, 52, 8, 8
CONTROL "", 1006, EDIT, ES_CENTER | ES_AUTOHSCROLL | ES_READONLY | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 55, 50, 60, 12
CONTROL "байт", 0, STATIC, SS_CENTER | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 120, 52, 20, 8
CONTROL ">", 1007, BUTTON, BS_DEFPUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 145, 50, 15, 12
CONTROL "!", 1008, BUTTON, BS_AUTOCHECKBOX | BS_PUSHLIKE | WS_CHILD | WS_VISIBLE | WS_TABSTOP, 165, 50, 15, 12
CONTROL "Результат", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 5, 67, 35, 8
CONTROL ":", 0, STATIC, SS_LEFT | SS_CENTERIMAGE | WS_CHILD | WS_VISIBLE | WS_GROUP, 45, 67, 8, 8
CONTROL "", 1009, EDIT, ES_CENTER | ES_AUTOHSCROLL | ES_READONLY | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_TABSTOP, 55, 65, 125, 12
}
Натолкнулся на проблему помогите разобраться:
С помощью Indy пытаюсь реализовать ssl +sock5
1)Для этого создал IdSSLIOHandlerSocket, IdSocksInfo, IdHTTP, взаимно их связал.
2)Библиотеки для поддержки SSL в Indy загрузил
При указании сокса и порта и выполнении операции Get выдается следующая ошибка:
Project raised exception class EAccessViolation with message
'Access violation at address 00475AB8 in module xxxx.exe.'
Read of address 00000014'.
При отключении сокса (в SocksInfo устанавливаю Version:=svNoSocks) сайт открывается без ошибок.
При подключении сокса, но при отключенном SSL режиме (просто http://) сайт также открывается нормально.
При одновременном https:// и наличии сокс-сервера выдается ошибка.
С помощью Indy пытаюсь реализовать ssl +sock5
1)Для этого создал IdSSLIOHandlerSocket, IdSocksInfo, IdHTTP, взаимно их связал.
2)Библиотеки для поддержки SSL в Indy загрузил
При указании сокса и порта и выполнении операции Get выдается следующая ошибка:
Project raised exception class EAccessViolation with message
'Access violation at address 00475AB8 in module xxxx.exe.'
Read of address 00000014'.
При отключении сокса (в SocksInfo устанавливаю Version:=svNoSocks) сайт открывается без ошибок.
При подключении сокса, но при отключенном SSL режиме (просто http://) сайт также открывается нормально.
При одновременном https:// и наличии сокс-сервера выдается ошибка.
Как сделать так чтобы при запросе:
ADOQuery1.SQL.Add('Select *');
ADOQuery1.SQL.Add('from Si');
ADOQuery1.SQL.Add('Where ZavN Like '''+Edit1.Text+'''');
ADOQuery1.Active:=True;
В DBGrid не отображалась одна найденная строка, а эта строка всреди остальных строк получала фокус?
ADOQuery1.SQL.Add('Select *');
ADOQuery1.SQL.Add('from Si');
ADOQuery1.SQL.Add('Where ZavN Like '''+Edit1.Text+'''');
ADOQuery1.Active:=True;
В DBGrid не отображалась одна найденная строка, а эта строка всреди остальных строк получала фокус?
Страницы: 12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667
Предыдущая тема: 1С: Конвертация данных 2.0
Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.