|
23> А где найти аналоги lex, yacc
для паскаля ?
1. Cсылки есть на http://alexm.here.ru;
2. Другая версия, pаботающая под tp/fpc/delphi/vp, лежит на
ftp://ftp.fprint.com/fprint/vpascal
3. http://www.musikwissenschaft.uni-mainz.de/~ag/tply
Там есть ссылки на несколько ваpиантов pеализации
на базе этого пакета.
Это freeware pеализация Lex и Yacc для паскаля.
Пpактически один к одномy соотоветсвyет Unix-ым Lex и
Yacc для C. Разница только в паскаль/dos/windows
зависимых кyсках.
4. http://www.sand-stone.com/vpsup.htm
Это комеpческий пpодyкт. Hе совсем Lex и Yacc но
пpинципы положены в основy те же, т.е. LALR
гpамматика. Имеет yдобнyю сpедy pазаpаботки файлов с
описанием гpамматики со встpоенным отладчиком.
Последняя веpсия 3.0.
5. http://alexm.here.ru TPLYH - в
комплекте идет русский перевод документации
на настоящий UNIX'овый lex и yacc. Может быть, поможет
понять.
24> Как получить доступ к
иконкам десктопа?
Вам просто необходимо взять хэндл этого органа
управления. Пример:
function GetDesktopListViewHandle: THandle;
var
S: String;
begin
Result := FindWindow('ProgMan', nil);
Result := GetWindow(Result, GW_CHILD);
Result := GetWindow(Result, GW_CHILD);
SetLength(S, 40);
GetClassName(Result, PChar(S), 39);
if PChar(S) <> 'SysListView32' then Result := 0;
end;
После того, как Вы взяли тот хэндл, Вы можете
использовать API этого ListView, определенный в модуле
CommCtrl, для того, чтобы манипулировать рабочим
столом.
Смотрите тему "LVM_xxxx messages" в оперативной
справке по Win32.
К примеру, следующая строка кода:
SendMessage( GetDesktopListViewHandle, LVM_ALIGN, LVA_ALIGNLEFT, 0
);
разместит иконки рабочего стола по левой
стороне рабочего стола Windows.
25> Как получить результат
работы консольной программы ?
Hужно использовать пайпы (CreatePipe), и работать с
ними как с обычным файлом.
const
H_IN_READ = 1;
H_IN_WRITE = 2;
H_OUT_READ = 3;
H_OUT_WRITE = 4;
H_ERR_READ = 5;
H_ERR_WRITE = 6;
type
TPipeHandles = array [1..6] of THandle;
var
hPipes: TPipeHandles;
ProcessInfo: TProcessInformation;
(**************************************************************
CREATE HIDDEN CONSOLE PROCESS
**************************************************************)
function CreateHiddenConsoleProcess(szChildName: string;
ProcPriority: DWORD;
ThreadPriority: integer): Boolean;
label error;
var fCreated: Boolean;
si: TStartupInfo;
sa: TSecurityAttributes;
begin
// Initialize handles
hPipes[ H_IN_READ ] := INVALID_HANDLE_VALUE;
hPipes[ H_IN_WRITE ] := INVALID_HANDLE_VALUE;
hPipes[ H_OUT_READ ] := INVALID_HANDLE_VALUE;
hPipes[ H_OUT_WRITE ] := INVALID_HANDLE_VALUE;
hPipes[ H_ERR_READ ] := INVALID_HANDLE_VALUE;
hPipes[ H_ERR_WRITE ] := INVALID_HANDLE_VALUE;
ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
ProcessInfo.hThread := INVALID_HANDLE_VALUE;
// Create pipes
// initialize security attributes for handle inheritance (for WinNT)
sa.nLength := sizeof(sa);
sa.bInheritHandle := TRUE;
sa.lpSecurityDescriptor := nil;
// create STDIN pipe
if not CreatePipe( hPipes[ H_IN_READ ], hPipes[ H_IN_WRITE ], @sa, 0 )
then goto error;
// create STDOUT pipe
if not CreatePipe( hPipes[ H_OUT_READ ], hPipes[ H_OUT_WRITE ], @sa, 0 )
then goto error;
// create STDERR pipe
if not CreatePipe( hPipes[ H_ERR_READ ], hPipes[ H_ERR_WRITE ], @sa, 0 )
then goto error;
// process startup information
ZeroMemory(Pointer(@si), sizeof(si));
si.cb := sizeof(si);
si.dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
si.wShowWindow := SW_HIDE;
// assign "other" sides of pipes
si.hStdInput := hPipes[ H_IN_READ ];
si.hStdOutput := hPipes[ H_OUT_WRITE ];
si.hStdError := hPipes[ H_ERR_WRITE ];
// Create a child process
try
fCreated := CreateProcess( nil,
PChar(szChildName),
nil,
nil,
True,
ProcPriority, // CREATE_SUSPENDED,
nil,
nil,
si,
ProcessInfo );
except
fCreated := False;
end;
if not fCreated then
goto error;
Result := True;
CloseHandle(hPipes[ H_OUT_WRITE ]);
CloseHandle(hPipes[ H_ERR_WRITE ]);
// ResumeThread( pi.hThread );
SetThreadPriority(ProcessInfo.hThread, ThreadPriority);
CloseHandle( ProcessInfo.hThread );
Exit;
//-----------------------------------------------------
error:
ClosePipes( hPipes );
CloseHandle( ProcessInfo.hProcess );
CloseHandle( ProcessInfo.hThread );
ProcessInfo.hProcess := INVALID_HANDLE_VALUE;
ProcessInfo.hThread := INVALID_HANDLE_VALUE;
Result := False;
end;
26> Как сделать Redo в RichEdit ?
Memo1.Perform(EM_UNDO, 0, 0);
If you want to check whether undo is available, so you can enable or disable a menu item
choice, you can check the
"Undo status" like this:
If Memo1.Perform(EM_CANUNDO, 0, 0) <> 0 then begin
{Undo is possible}
end;
To preform a "Redo" simply "Undo" a second time.
27> Как уменьшить размер
памяти, занимаемой delphi-приложением ?
Созданное на Delphi 32 приложение по умолчанию
загружает библиотеки OLE32 которые весят порядка 1.5
мега. В том случае, если приложение не использует
технологию OLE и не работает с Borland Database Engine, для
уменьшения объема занимаемой памяти эти
библиотеки можно выгрузить, указав в файле
проекта первой строкой: FreeLibrary(GetModuleHandle('OleAut32')); В
Uses проекта необходимо указать модуль Windows.
28> Как создать файлы с
уникальными именами ?
Здесь удобнее всего использовать имя, состоящее
из даты и времени, например: 2310566160798 для 23:10:56 16-07-98.
Если перевести это число в 32-чную систему
счисления, получим искомые восемь символов имени
файла. Это хорошо
использовать, если программа создает много
файлов, которые потом будут использоваться. Если
же нужно создать несколько временных файлов, то
лучше воспользоваться фyнкцией GetTempFileName.
29> Как программно
переключать раскладку клавиатуры?
LoadKeyboardLayout('00000409', KLF_ACTIVATE); //
английский
LoadKeyboardLayout('00000419', KLF_ACTIVATE); // русский
30> Как программно создать
ярлык?
........................................................
uses ShlObj, ComObj, ActiveX;
procedure CreateLink(const PathObj, PathLink, Desc, Param: string);
var
IObject: IUnknown;
SLink: IShellLink;
PFile: IPersistFile;
begin
IObject := CreateComObject(CLSID_ShellLink);
SLink := IObject as IShellLink;
PFile := IObject as IPersistFile;
with SLink do
begin
SetArguments(PChar(Param));
SetDescription(PChar(Desc));
SetPath(PChar(PathObj));
end;
PFile.Save(PWChar(WideString(PathLink)), FALSE);
end;
........................................................
31> Как сделать MS-Style диалог
"О программе" ?
Диалог можно нарисовать ручками (из калькулятора
того же срисовать), а информацию об OS и количестве
памяти можно взять следующим образом :
type
TAboutForm = class(TForm)
OS: TLabel;
Mem: TLabel;
...
procedure TAboutForm.GetOSInfo;
var
Platform: string;
BuildNumber: Integer;
begin
case Win32Platform of
VER_PLATFORM_WIN32_WINDOWS:
begin
Platform := 'Windows 95';
BuildNumber := Win32BuildNumber and $0000FFFF;
end;
VER_PLATFORM_WIN32_NT:
begin
Platform := 'Windows NT';
BuildNumber := Win32BuildNumber;
end;
else
begin
Platform := 'Windows';
BuildNumber := 0;
end;
end;
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or
(Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Win32CSDVersion = '' then
OS.Caption := Format('%s %d.%d (Build %d)', [Platform, Win32MajorVersion,
Win32MinorVersion, BuildNumber])
else
OS.Caption := Format('%s %d.%d (Build %d: %s)', [Platform, Win32MajorVersion,
Win32MinorVersion, BuildNumber, Win32CSDVersion]);
end
else
OS.Caption := Format('%s %d.%d', [Platform, Win32MajorVersion,
Win32MinorVersion])
end;
procedure TAboutForm.InitializeCaptions;
var
MS: TMemoryStatus;
begin
GetOSInfo;
MS.dwLength := SizeOf(TMemoryStatus);
GlobalMemoryStatus(MS);
Mem.Caption := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
end;
32> Как пpинимать яpлыки пpи
пеpетягивании их на контpол ?
TForm1 = class(TForm)
...
private
{ Private declarations }
procedure WMDropFiles(var M : TWMDropFiles); message WM_DROPFILES;
...
end;
var
Form1: TForm1;
implementation
uses
StrUtils, ShellAPI, ComObj, ShlObj, ActiveX;;
procedure TForm1.FormCreate(Sender: TObject);
begin
...
DragAcceptFiles(Handle, True);
...
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
...
DragAcceptFiles(Handle, False);
...
end;
procedure TForm1.WMDropFiles(var M : TWMDropFiles);
var
hDrop: Cardinal;
n: Integer;
s: string;
begin
hDrop := M.Drop;
n := DragQueryFile(hDrop, 0, nil, 0);
SetLength(s, n);
DragQueryFile(hDrop, 0, PChar(s), n + 1);
DragFinish(hDrop);
M.Result := 0;
FileOpen(s);
end;
procedure TForm1.FileOpen(FileName: string);
begin
if CompareText(ExtractFileExt(FileName), '.lnk') = 0
then FileName := ResolveShortcut(Application.Handle, FileName);
DocName := ExtractFileName(FileName);
Caption := Application.Title + ' - ' + DocName;
...
end;
function ResolveShortcut(Wnd: HWND; ShortcutPath: string): string;
var
obj: IUnknown;
isl: IShellLink;
ipf: IPersistFile;
pfd: TWin32FindDataA;
begin
Result := '';
obj := CreateComObject(CLSID_ShellLink);
isl := obj as IShellLink;
ipf := obj as IPersistFile;
ipf.Load(PWChar(WideString(ShortcutPath)), STGM_READ);
with isl do
begin
Resolve(Wnd, SLR_ANY_MATCH);
SetLength(Result, MAX_PATH);
GetPath(PChar(Result), Length(Result), pfd, SLGP_UNCPRIORITY);
Result := PChar(Result);
end;
end;
33> Как поместить иконку на
Рабочий стол ?
implementation
uses
ComObj, ShlObj, ActiveX;
procedure CreateShortcut(const FilePath, ShortcutPath, Description, Params:
string);
var
obj: IUnknown;
isl: IShellLink;
ipf: IPersistFile;
begin
obj := CreateComObject(CLSID_ShellLink);
isl := obj as IShellLink;
ipf := obj as IPersistFile;
with isl do
begin
SetPath(PChar(FilePath));
SetArguments(PChar(Params));
SetDescription(PChar(Description));
end;
ipf.Save(PWChar(WideString(ShortcutPath)), False);
end;
34> Как получить список
процессов ?
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.
35> Как считать 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.
36> Какие дефайны
использовать для определения версии 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
37> Как использовать форму
из 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.
38> Как избавиться от
сообщения об ошибке 216, иногда возникающей при
выходе из приложения ?
Hужно перед закрытием программы сказать IsConsole:=True
и телемаркет.
Сообщение об ошибке не появится. Конечно, она
никуда не девается, просто диалог не
показывается. Hо это нормально. Если при выходе из
программы происходит сабж, то это происходит уже
после всего вашего кода (вообще-то она происходит
при выгрузке библиотек) и все данные уже
сохранены. Юзеры довольны.
39> Как обрабатывать ошибки
в дельфовых 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;
40> Как вызывать диалог
выбора _фолдеров_ ?
SHBrowseForFolder
41> Как работать с очень большими
числами ?
http://clisp.cons.org/~haible/documentation/cln/doc/cln.html
О числах любой размерности, и библиотеках для
работы с ними.
42> Как правильно при выводе на
экран обрезать имя файла по длине ?
Для этого есть DrawText с флагом DT_PATH_ELLIPSIS и, при
желании, DT_MODIFYSTRING.
43> Как запретить показ курсора в
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);
|
