» Вопросы по Delphi (все версии) - часть 3

BrdGuest
RomanTim
Спасибо, господа!
Я написал так:

Код: var
Form1: TForm1;
tokenhandle: THandle;
tp: TTokenPrivileges;
X: cardinal;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

begin
if OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, tokenhandle) then
if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tp.Privileges[0].Luid) then
begin
tp.PrivilegeCount:=1;
tp.Privileges[0].Attributes:=SE_PRIVILEGE_ENABLED;
If AdjustTokenPrivileges(TokenHandle, false, tp, 0, nil, X) then
ExitWindowsEx(EWX_SHUTDOWN,0)
end
end;

end.

Здравствуйте. У меня такой вопрос:
если есть только исполнительный файл проекта, можно каким - нибудь способом получить из него исходники?

ALPeresvet
Программу, написанную на Делфи, можно попробовать "декомпилировать" тулзой DeDe (взять можно здесь). Однако полноценные исходники ты таким образом не получишь.

delover
Внимательно посмотри настройки. Страничка Transform->Add or remove...->Leave begin and end as is

Цитата:

if BlaBla then exit
else continue;

у меня форматирует как

Цитата:

if BlaBla then
exit
else
continue;

Вот мой конфигурационный файл: JCFSettings.cfg
Единственное что мне не нравится, это то, как он комменты форматирует.

Добавлено:
ALPeresvet
Добавлю, получишь названия процедур и функций а внутри код на ассемблере. Ну и ещё формы получишь со всеми компонентами. Например, ImageList со всеми картинками.

нужна помощь. поисковик текста запускается, но текст не ищет, вот код:

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
FindDialog1: TFindDialog;
procedure Button1Click(Sender: TObject);
procedure FindDialog1Find(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
FindDialog1.Execute;
end;

procedure TForm1.FindDialog1Find(Sender: TObject);
var
Buff, P, FT: PChar;
BuffLen: Word;
begin
with Sender as TFindDialog do
begin
GetMem(FT, Length(FindText) + 1);
StrPCopy(FT, FindText);
BuffLen := Memo1.GetTextLen + 1;
GetMem(Buff, BuffLen);
Memo1.GetTextBuf(Buff, BuffLen);
P := Buff + Memo1.SelStart + Memo1.SelLength;
P := StrPos(P, FT);
if P = nil then
MessageBeep(0)
else
begin
Memo1.SelStart := P - Buff;
Memo1.SelLength := Length(FindText);
end;
FreeMem(FT, Length(FindText) + 1);
FreeMem(Buff, BuffLen);
end;
end;
end.

Fallen_Angel_888
_http://www.swissdelphicenter.ch/en/showcode.php?id=1881
и спрячь код в more

skinash
Спасибо получилось почти так как надо. Единственное я оставляю без переноса строки типа

Код:
if p = nil then exit;
//а не так
if p = nil then
exit;

delover

Цитата:

Единственное я оставляю без переноса строки типа

Код: if p = nil then exit;
//а не так
if p = nil then
exit;

MrGalaxy
По поводу EWX_FORCE. Был когда то написанный код, я его кинул, задача, под которую он писался, не предусматривала попыток аккуратно завершить приложения.
На счет делфи под Vista x64. У меня вроде без проблем встала 2007 (которая в общем то и выпускалась чтобы нормально висту поддержать). Одно но - обновление при установке подвисает, а на 2003 x64 установилось без проблем

Господа!
Возникла задача - перехват программой нажатия клавиши SLEEP.
Поскольку ни в книжках, что есть у меня, ни в справке Делфи нет кода клавиш управления питанием, то написал такую программульку, чтобы этот код узнать:
http://slil.ru/25238047

---

[more=код программы]
Код: unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, AppEvnts, ExtCtrls;

type
TForm1 = class(TForm)
Label1: TLabel;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

var buf: TKeyboardState;
i: word;
L: longbool;
P: string;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
Label1.Caption:='';
GetKeyboardState(buf);
L:=false;
P:='';
for i:=2 to 255 do
begin
if buf[i]=1 then
begin
if L then P:=' + ';
Label1.Caption:=Label1.Caption+P+inttostr(i);
L:=true;
buf[i]:=0
end;
end;
SetKeyboardState(buf)
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
for i:=0 to 255 do buf[i]:=0;
SetKeyboardState(buf)
end;

end.

Хочу написать сканер серверов кс взял idUDPClient
вот код:

===================
d.Host:='192.168.1.201';
d.Port:=27015;
d.Send('');
if d.ReceiveString<>'' then
memo1.Text:='есть серв'
else
memo1.Text:='нет серв'
===================

дак вот вопрос как мне узнать что послать на сервак снифаком поработал
выкидывает


========================= Packet 0 =========================
Source Address : 0.0.0.0:1032
Destination Address: 255.255.255.255:27015
Protocol : UDP
Summary : UDP: Source port = 1032, Destination port = 27015
Length : 57
UDP: Source = 0.0.0.0:1032, Destination = 255.255.255.255:27015

0000: FF FF FF FF 54 53 6F 75 72 63 65 20 45 6E 67 69 ....TSource Engi
0010: 6E 65 20 51 75 65 72 79 00 01 00 10 00 9E 00 00 ne Query........
0020: 00 00 00 00 00 01 00 00 00 00 00 00 00 01 00 00 ................
0030: 00 00 00 00 00 00 00 00 00 .........

=====================================================

Хм, подскажите как упорядочить текст в ListView во втором столбце. Как нужно правильно послать команду LVM_SORTITEMS в контрол.

MrGalaxy
А ты не пробовал ловить код клавиши по-другому?
Например, так:


Код: unit MainForm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TMain = class(TForm)
Label1: TLabel;
procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Main: TMain;

implementation

{$R *.dfm}

procedure TMain.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin

Label1.Caption := IntToStr(Key);
Key := 0;

end;

end.

4kusNick

Цитата:

А если тебе нужно отрубать кнопку выключения например в то время, пока запущен твой перехватчик, то наверное, грамотнее будет, если ты сделаешь как раз отключение реакции на нажатие этой кнопки, чтобы автоматом в винде ставилось действие по нажатию кнопок сна\выключения питания и т.д. Это будет грамотнее с той точки зрения, что вдруг, у кого-нить все-таки коды отличаются?

Ничего не понимаю... Даже если делать отключение реакции на эти клавиши, то всё-равно их код надо знать. Или Вы что-то другое подразумевали?

Кто-нибудь имеет опыт работы с Virtual Treeview component written by Mike Lischke? Не соображу как сделать типа этого:
+ Level_0
-----+Level_1
------Level_2: col1 col2 col3
------Level_2: col1 col2 col3
....................................
------Level_2: col1 col2 col3
+ Level_0
-----+Level_1
------Level_2: col1 col2 col3
------Level_2: col1 col2 col3
....................................
------Level_2: col1 col2 col3

Т.е. Level_0 и Level_1 - это просто папки, кол-во которых заранее известно и статично, а сами данные должны находится на Level_2 в нескольких столбцах.
Как сие сделать?

relictus

Цитата:

Т.е. Level_0 и Level_1 - это просто папки, кол-во которых заранее известно и статично, а сами данные должны находится на Level_2 в нескольких столбцах.
Как сие сделать?

Не очень понятно - сделать что? Если отрисовать, то формируешь столбцы в дизайн или рантайме, потом основной метод - GetText, в нем определяешь, что будет показываться в ячейке:

    P := vtDummy.GetNodeData(Node);
    if P = nil then
    begin
        CellText := ' ';
        exit;
    end;
    case Column of
        0: CellText := ... то что тебе надо;


P : определяемая тобой структура данных.

При желании можно использовать BeforeCellPaint, PaintText для наведения красивостей при отрисовке.
А вообще все это хорошо описано в демках с сайта soft-gems.

Привет всем.
Мне нужен jpeg.pas из RAD2007, чтобы исправить в нем глюк при работе в фоновом потоке. Уже нашел эту ссылку (спасибо vladk1973)
_http://redacid.org.ua/ftp/media1/all_soft/pc/develop/delphi_7/info/extras/jpeg/jpeg.pas
но она от D7. Кто-нибудь может подсказать, изменился ли этот файл с тех пор или он тот же самый ?

Насчет самого глюка:
Есть
procedure TJPEGImage.Draw(ACanvas: TCanvas; const Rect: TRect);
begin
ACanvas.StretchDraw(Rect, Bitmap);
end;
Приватный внутренний bmp не лочится, в результате иногда чернота вместо изображения.

Надо
procedure TJPEGImage.Draw(ACanvas: TCanvas; const Rect: TRect);
begin
Bitmap.Canvas.Lock;
try
ACanvas.StretchDraw(Rect, Bitmap);
finally
Bitmap.Canvas.Unlock;
end;
end;

BugDigger
http://qc.codegear.com/wc/qcmain.aspx?d=55871
Жди, может поправят)

Rudia

Цитата:

Жди, может поправят

Ну дык это до бесконечности можно ждать. А глюк-то он сегодня происходит.
Так всё же, есть ли у кого-нибудь версия от 2007? Или таки этот файл остался тем же со времен D7 ?

Chukotka
Спасибо.. это именно то, что нужно:
P := vtDummy.GetNodeData(Node);
if P = nil then ...

Подскажите, как узнать что какой либо файл, например dbf, не занят каким-либо пользователем или процессом?

diodio
если используется другим приложением

Код: try
F := TFileStream.Create(Origin, fmOpenReadWrite or fmShareExclusive);
try
Result := true;
finally
F.Free;
end;
except
Result := false;
end;

Спасибо.

Приветствую знатоки, нужно реализовать хранение интервалов времени, и очень желательно это делать визуально! Что-то вроде этого http://suchov.narod.ru/pict/muxa1.gif

VaXoID2
хранить списком, отображать в сетке.

Подскажите как отобразить информацию о загруженности процессора и оперативки в Label ?

О загруженности процессора посмотри ...[more]
const
SystemBasicInformation = 0;
SystemPerformanceInformation = 2;
SystemTimeInformation = 3;

type
TPDWord = ^DWORD;

TSystem_Basic_Information = packed record
dwUnknown1: DWORD;
uKeMaximumIncrement: ULONG;
uPageSize: ULONG;
uMmNumberOfPhysicalPages: ULONG;
uMmLowestPhysicalPage: ULONG;
uMmHighestPhysicalPage: ULONG;
uAllocationGranularity: ULONG;
pLowestUserAddress: Pointer;
pMmHighestUserAddress: Pointer;
uKeActiveProcessors: ULONG;
bKeNumberProcessors: byte;
bUnknown2: byte;
wUnknown3: word;
end;

type
TSystem_Performance_Information = packed record
liIdleTime: LARGE_INTEGER; {LARGE_INTEGER}
dwSpare: array[0..75] of DWORD;
end;

type
TSystem_Time_Information = packed record
liKeBootTime: LARGE_INTEGER;
liKeSystemTime: LARGE_INTEGER;
liExpTimeZoneBias: LARGE_INTEGER;
uCurrentTimeZoneId: ULONG;
dwReserved: DWORD;
end;

var
NtQuerySystemInformation: function(infoClass: DWORD;
buffer: Pointer;
bufSize: DWORD;
returnSize: TPDword): DWORD; stdcall = nil;


liOldIdleTime: LARGE_INTEGER = ();
liOldSystemTime: LARGE_INTEGER = ();

function Li2Double(x: LARGE_INTEGER): Double;
begin
Result := x.HighPart * 4.294967296E9 + x.LowPart
end;

procedure GetCPUUsage;
var
SysBaseInfo: TSystem_Basic_Information;
SysPerfInfo: TSystem_Performance_Information;
SysTimeInfo: TSystem_Time_Information;
status: Longint; {long}
dbSystemTime: Double;
dbIdleTime: Double;

bLoopAborted : boolean;

begin
if @NtQuerySystemInformation = nil then
NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),
'NtQuerySystemInformation');

// get number of processors in the system

status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil);
if status <> 0 then Exit;

// Show some information
with SysBaseInfo do
begin
ShowMessage(
Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13+
'uMmNumberOfPhysicalPages: %d'+#13+'uMmLowestPhysicalPage: %d'+#13+
'uMmHighestPhysicalPage: %d'+#13+'uAllocationGranularity: %d'#13+
'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d',
[uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages,
uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity,
uKeActiveProcessors, bKeNumberProcessors]));
end;


bLoopAborted := False;

while not bLoopAborted do
begin

// get new system time
status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);
if status <> 0 then Exit;

// get new CPU's idle time
status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);
if status <> 0 then Exit;

// if it's a first call - skip it
if (liOldIdleTime.QuadPart <> 0) then
begin

// CurrentValue = NewValue - OldValue
dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);
dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);

// CurrentCpuIdle = IdleTime / SystemTime
dbIdleTime := dbIdleTime / dbSystemTime;

// CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;

// Show Percentage
Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %',dbIdleTime);

Application.ProcessMessages;

// Abort if user pressed ESC or Application is terminated
bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated;

end;

// store new CPU's idle and system time
liOldIdleTime := SysPerfInfo.liIdleTime;
liOldSystemTime := SysTimeInfo.liKeSystemTime;

// wait one second
Sleep(1000);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GetCPUUsage
end;
[/more]

Чонто не могу сделать прогресс бар для idftp если создаю его в коде
unit ftp;
uses ...;
var
clFtp:Tidftp;
procedure clFTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
procedure clFTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
implementation

uses UnitSetup, UnitMain;
****
clftp:=tidftp.Create();
.....
procedure clFTPWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
FormMain.ProgressBar1.Position:= AWorkCount;
FormMain.ProgressBar1.Refresh;
Application.ProcessMessages;
end;

procedure clFTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
begin
FormMain.ProgressBar1.Position:=0;
FormMain.ProgressBar1.Max:=AWorkCountMax;
end;

как процедуры к событиям прописать?
как ваще правильно энто делать в таком случае?