500+ FAQ по Delphi

Перейти на: Главную | Индексную | Предыдущую | Следующую страницу


Как получить список процессов ?

procedure TForm1.Button1Click(Sender: TObject);
var
handler:thandle;
data:TProcessEntry32;
function return_name:string;
var
i:byte;
names:string;
begin
names:='';
i:=0;
while data.szExeFile[i] <> '' do
begin
names:=names+data.szExeFile[i];
inc(i);
end;
return_name:=names;
end;

begin
handler:=createtoolhelp32snapshot(TH32CS_SNAPALL,0);
if process32first(handler,data) then begin
listbox1.Items.add(return_name);
while process32next(handler,data) do
listbox1.Items.add(return_name);
end
else
showmessage('Ошибка получения информации :)');
end;

А запускать например так:
procedure TForm1.Label3Click(Sender: TObject);
begin
shellexecute(handle,'open','mailto:maxrus@mail.ru',nil,nil,0)
end;
end.

Как считать CRC-32 ?

unit ChkSumm;

interface

const
CRC32INIT = $FFFFFFFF;
{----------------------------------------------------------------}
{ Buffer - массив байтов, для которого подсчитывается CRC }
{ CRC - начальное значение CRC }
{ Count - длина буфера }
{----------------------------------------------------------------}
function CalculateBufferCRC32( CRC : Cardinal;
const Buffer;
Count : Cardinal ) : Cardinal;
register;
{----------------------------------------------------------------}
{ Расчет 32-битовой CRC, алгоритм аналогичен применяемому в }
{ архиваторах ZIP, ARJ. При этом начальное значение CRC должно }
{ быть равно CRC32INIT, а после окончания подсчета окончательная }
{ CRC вычисляется по формуле : }
{ CRC := CRC xor CRC32INIT; }
{ Hапример : }
{ var }
{ Buffer : array[1..8192] of Char; }
{ CRC : Cardinal; }
{ Count : Cardinal; }
{ ....... }
{ CRC := CRC32INIT; }
{ repeat }
{ BlockRead(F, Buffer, SizeOf( Buffer ), Count); }
{ CRC := CalculateBufferCRC32( CRC, Buffer, Count ); }
{ until Eof(F); }
{ CRC := CRC xor CRC32INIT; }
{ ....... }
{----------------------------------------------------------------}
implementation

const
CRC32Table : array[0..255] of Cardinal = (
$00000000, $77073096, $EE0E612C, $990951BA, $076DC419, $706AF48F, $E963A535,
$9E6495A3, $0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988, $09B64C2B, $7EB17CBD,
$E7B82D07, $90BF1D91, $1DB71064, $6AB020F2, $F3B97148, $84BE41DE, $1ADAD47D,
$6DDDE4EB, $F4D4B551, $83D385C7, $136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5, $3B6E20C8, $4C69105E, $D56041E4,
$A2677172, $3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B, $35B5A8FA, $42B2986C,
$DBBBC9D6, $ACBCF940, $32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59, $26D930AC,
$51DE003A, $C8D75180, $BFD06116, $21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924, $2F6F7C87, $58684C11, $C1611DAB,
$B6662D3D, $76DC4190, $01DB7106, $98D220BC, $EFD5102A, $71B18589, $06B6B51F,
$9FBFE4A5, $E8B8D433, $7807C9A2, $0F00F934, $9609A88E, $E10E9818, $7F6A0DBB,
$086D3D2D, $91646C97, $E6635C01, $6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457, $65B0D9C6, $12B7E950, $8BBEB8EA,
$FCB9887C, $62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65, $4DB26158, $3AB551CE,
$A3BC0074, $D4BB30E2, $4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB, $4369E96A,
$346ED9FC, $AD678846, $DA60B8D0, $44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086, $5768B525, $206F85B3, $B966D409,
$CE61E49F, $5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4, $59B33D17, $2EB40D81,
$B7BD5C3B, $C0BA6CAD, $EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A, $EAD54739,
$9DD277AF, $04DB2615, $73DC1683, $E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1, $F00F9344, $8708A3D2, $1E01F268,
$6906C2FE, $F762575D, $806567CB, $196C3671, $6E6B06E7, $FED41B76, $89D32BE0,
$10DA7A5A, $67DD4ACC, $F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5, $D6D6A3E8,
$A1D1937E, $38D8C2C4, $4FDFF252, $D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60, $DF60EFC3, $A867DF55, $316E8EEF,
$4669BE79, $CB61B38C, $BC66831A, $256FD2A0, $5268E236, $CC0C7795, $BB0B4703,
$220216B9, $5505262F, $C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04, $C2D7FFA7,
$B5D0CF31, $2CD99E8B, $5BDEAE1D, $9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713, $95BF4A82, $E2B87A14, $7BB12BAE,
$0CB61B38, $92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21, $86D3D2D4, $F1D4E242,
$68DDB3F8, $1FDA836E, $81BE16CD, $F6B9265B, $6FB077E1, $18B74777, $88085AE6,
$FF0F6A70, $66063BCA, $11010B5C, $8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2, $A7672661, $D06016F7, $4969474D,
$3E6E77DB, $AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0, $A9BCAE53, $DEBB9EC5,
$47B2CF7F, $30B5FFE9, $BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6, $BAD03605,
$CDD70693, $54DE5729, $23D967BF, $B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D );


function CalculateBufferCRC32( CRC : Cardinal;
const Buffer;
Count : Cardinal ) : Cardinal;
assembler;
asm
PUSH ESI
PUSH EDI
MOV ESI, Buffer
// MOV ECX, Count // uncomment these strings
// MOV EAX, CRC // if not use REGISTER calling convention
CLD
@@Loop:
MOV EDI, EAX // copy CRC into DI
LODSB // load next byte into AL
XOR EDI, EAX // put array index into DL
SHR EAX, 8 // shift CRC one byte right
SHL DI, 2 // correct DI
XOR EAX, DWORD PTR CRC32Table[EDI] // calculate next CRC value
LOOP @@Loop
POP EDI
POP ESI
end;

end.

Какие дефайны использовать для определения версии Delphi/CPPB ?

{$IFDEF VER80} - D1 (Delphi 1.0)
{$IFDEF VER90} - D2
{$IFDEF VER93} - B1 (Builder 1.0)
{$IFDEF VER100} - D3
{$IFDEF VER110} - B3
{$IFDEF VER120} - D4

Как использовать форму из DLL ?

Это файл Form.dpr, из которого получается DLL:

library Form;
uses
Classes,
Unit1 in 'Unit1.pas' {Form1};
exports
CreateMyForm,
DestroyMyForm;
end.

Это его Unit1:

unit Unit1;
interface
[раздел uses и определение класса Form1 поскипаны]
procedure CreateMyForm(AppHandle : THandle); stdcall;
procedure DestroyMyForm; stdcall;
implementation
{$R *.DFM}
procedure CreateMyForm(AppHandle : THandle);
begin
Application.Handle:=AppHandle;
Form1:=TForm1.Create(Application);
Form1.Show
end;
procedure DestroyMyForm;
begin
Form1.Free
end;
end.


Это UnitCall вызывающего EXE-шника:

unit UnitCall;
interface
[раздел uses и определение класса Form1 поскипаны]
procedure CreateMyForm(AppHandle : THandle); stdcall; external 'Form.dll';
procedure DestroyMyForm; stdcall; external 'Form.dll';
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
CreateMyForm(Application.Handle)
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DestroyMyForm
end;
end.

Как избавиться от сообщения об ошибке 216, иногда возникающей при выходе из приложения ?

Hужно перед закрытием программы сказать IsConsole:=True и телемаркет.

Сообщение об ошибке не появится. Конечно, она никуда не девается, просто диалог не показывается. Hо это нормально. Если при выходе из программы происходит сабж, то это происходит уже после всего вашего кода (вообще-то она происходит при выгрузке библиотек) и все данные уже сохранены. Юзеры довольны.

Как обрабатывать ошибки в дельфовых COM-объектах ?

TCustomBasePlugObject = class ( TAutoObject, IUnknown, IDispatch )
...
protected
function SafeCallException(ExceptObject: TObject; ExceptAddr:
Pointer): {$IFDEF _D4_}HResult{$ELSE}Integer{$ENDIF}; override;
...

function TCustomBasePlugObject.SafeCallException;
var ExMsg:String;
begin
Result := inherited SafeCallException(ExceptObject, ExceptAddr);
Try
if ExceptObject is EAbort then exit;
ExMsg := 'Exception: PlugObject="'+ClassName+'"';
if ExceptObject is Exception then
begin
ExMsg := ExMsg + #13' Message: '#13' '+
Exception(ExceptObject).Message+
#13' Module:'+GetModuleFileName+
#13' Adress:'+Format('%p',[ExceptAddr]);
if (ExceptObject is EOleSysError) and
(EOleSysError(ExceptObject).ErrorCode < 0)
then ExMsg := ExMsg + #13'
OleSysError.ErrorCode='+IntToStr(EOleSysError(ExceptObject).ErrorCode);
end;
toLog(ExMsg);
Except
End;
end;

Как вызывать диалог выбора _фолдеров_ ?

SHBrowseForFolder

Как работать с очень большими числами ?

http://clisp.cons.org/~haible/documentation/cln/doc/cln.html
О числах любой размерности, и библиотеках для работы с ними.

Как правильно при выводе на экран обрезать имя файла по длине ?

Для этого есть DrawText с флагом DT_PATH_ELLIPSIS и, при желании, DT_MODIFYSTRING.

Как запретить показ курсора в TEdit и ему подобных контролах ?

Создайте своего потомка с обработчиками:
procedure WMPaint(var Msg: TMessage); message WM_Paint;
procedure WMSetFocus(var Msg: TMessage); message WM_SetFocus;
procedure WMNCHitTest(var Msg: TMessage); message WM_NCHitTest;

в которых вызывайте:
inherited;
HideCaret(Handle);

Как бы мне соорудить в SP исключение, чтобы его увидел Delphi-клиент?

sqlstate='99999' не подходит, так как хочется на клиенте видеть код исключения.

Используй RAISERROR с кодом >20000. Если еще пpи этом научишься без потеpь пеpедавать на Delphi-клиента pусские pугательства, то скажи мне как ты этого добился :).

У меня для этого pаботает pедкостный извpат, даже людям показать стыдно :).

Есть некоторая таблица и требуется при нажатии на кнопку создавать таблицы такой же структуры. Подскажите, как это удобнее всего сделать?

Удобней всего, напpимеp, так -

with bmovMyBatchMove do
begin
Mode := bmCopy;
RecordCount := 1;
Execute;
Destination.Delete;
end;

Где bmovMyBatchMove - экземпляр класса TBatchMove из VCL.

Akzhan Abdulin

(2:5040/55.46)

--------------------------------------------------------------------------------

Hеправда Ваша! ;)
Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:
увеличивает в создаваемых таблицах в полях типа NUMBER количество значащих цифр после запятой (не помню - возможно, что и до), если там указаны небольшие (около 1-3 цифр) значения :(.
Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.
Кроме того, в предложенном выше варианте еще и запись удалять приходится...:)
Решалась же эта проблема следующим способом:

procedure CopyStruct( SrcTable, DestTable: TTable; cpyFields: array of string );
var
i: Integer;
bActive: Boolean;
SrcDatabase,DestDatabase: TDatabase;
iSrcMemSize,iDestMemSize: Integer;
pSrcFldDes: PFldDesc; CrtTableDesc: CRTblDesc;
bNeedAllFields: Boolean;
begin
SrcDatabase := Session.OpenDatabase( SrcTable.DatabaseName );
try
DestDatabase := Session.OpenDatabase( DestTable.DatabaseName );
try
bActive := SrcTable.Active;
SrcTable.FieldDefs.Update;
iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf( FLDDesc );
pSrcFldDes := AllocMem( iSrcMemSize );
if pSrcFldDes = nil then
begin
raise EOutOfMemory.Create( 'Не хватает памяти!' );
end;
try
SrcTable.Open;
Check( DbiGetFieldDescs( SrcTable.Handle, pSrcFldDes ) );
SrcTable.Active := bActive;
FillChar( CrtTableDesc, SizeOf( CrtTableDesc ), 0 );
with CrtTableDesc do
begin
StrPcopy( szTblName, DestTable.TableName );
StrPcopy( szTblType, 'DBASE');
if ( Length( cpyFields[0] ) = 0 ) or ( cpyFields[0] = '*' ) then
begin
bNeedAllFields := True;
SrcTable.FieldDefs.Update;
iFldCount := SrcTable.FieldDefs.Count;
end
else
begin
bNeedAllFields := False;
iFldCount := High( cpyFields ) + 1;
end;
iDestMemSize := iFldCount * Sizeof( FLDDesc );
CrtTableDesc.pFLDDesc := AllocMem( iDestMemSize );
if CrtTableDesc.pFLDDesc = nil then
begin
raise EOutOfMemory.Create( 'Не хватает памяти!' );
end;
end;
try
if bNeedAllFields then
begin
for i := 0 to CrtTableDesc.iFldCount - 1 do
begin
Move( PFieldDescList( pSrcFldDes )^[i], PFieldDescList( CrtTableDesc.pFLDDesc )^[i], SizeOf( FldDesc ) );
end;
end
else
begin
for i:=0 to CrtTableDesc.iFldCount-1 do
begin
Move( PFieldDescList( pSrcFldDes )^[SrcTable.FieldDefs.Find( cpyFields[i] ).FieldNo - 1], PFieldDescList( CrtTableDesc.pFLDDesc )^[i], SizeOf( FldDesc ) );
end;
end;
Check( DbiCreateTable( DestDatabase.Handle, True, CrtTableDesc ) );
finally
FreeMem( CrtTableDesc.pFLDDesc, iDestMemSize );
end;
finally
FreeMem( pSrcFldDes, iSrcMemSize );
end;
finally
Session.CloseDatabase( DestDatabase );
end;
finally
Session.CloseDatabase( SrcDatabase );
end;
end;

Vlad Fillippov

(2:5055/34.3)

Как заставить Interbase принять COLLATE PXW_CYRL по умолчанию?

Чтобы не писать каждый раз COLLATE, я сделал следующее:

1) Создал сохранённую процедуру

create procedure fix_character_sets
as
begin
update
rdb$character_sets
set
rdb$default_collate_name = 'PXW_CYRL'
where
rdb$character_set_name = 'WIN1251'
and
rdb$default_collate_name = 'WIN1251'
;
end

2) Запустил ее один раз.

3) Создаю таблицы без указания COLLATE.

4) После восстановления из архива, запускаю еще раз.

Кудрин Олег, АТС-55, Красноярск.

oleg@ats.telecom.krasnoyarsk.su


Материалы находятся на сайте http://cracklab.narod.ru/faq/


Создатель этого HTML файла не претендует на авторство вопросов/ответов представленных в нём, не отвечает за их содержание и достоверность, а также за последствия использования программных кодов , полученных из этого HTML файла. Также не принимаются претензии относительно не размещённой информации об авторе каждого конкретного FAQ'а. Любые другие вопросы присылайте на bad_guy@cracklab.ru (обращаться к Bad_guy'ю).
Hosted by uCoz