Выставляем горячие клавиши для Delphi приложения
Выставляем горячие клавиши для Delphi приложения
Как сделать так, чтобы при минимизации приложения в Tray его можно было вызвать определённой комбинацией клавиш, например Alt-Shift-F9 ?
//В обработчике события OnCreate
//основной формы создаём горячую клавишу:
If not RegisterHotkey
(Handle, 1, MOD_ALT or MOD_SHIFT, VK_F9) Then
ShowMessage('Unable to assign Alt-Shift-F9 as hotkey.');
//В событии OnClose удаляем горячую клавишу:
UnRegisterHotkey( Handle, 1 );
//Добавляем обработчик в форму для сообщения
//WM_HOTKEY:
private // в секции объявлений формы
Procedure WMHotkey( Var msg: TWMHotkey );
message WM_HOTKEY;
Procedure TForm1.WMHotkey( Var msg: TWMHotkey );
Begin
If msg.hotkey = 1 Then Begin
If IsIconic( Application.Handle ) Then
Application.Restore;
BringToFront;
End;
End;
Взято с Vingrad.ru
Вывести полупрозрачный текст
Вывести полупрозрачный текст
procedureTForm1.FormPaint(Sender: TObject);
var
x, y: integer;
bm: TBitMap;
begin
Form1.ClientWidth := 200;
Form1.ClientHeight := 100;
randomize;
for x := 0 to 199 do
for y := 0 to 99 do
if random(3) = 1 then
Form1.Canvas.Pixels[x,y] := clGreen
else
Form1.Canvas.Pixels[x,y] := clLime;
bm := TBitMap.Create;
bm.Width := 200;
bm.Height := 100;
with bm.Canvas do
begin
Brush.Color := clGreen;
FillRect(ClipRect);
Font.name := 'Arial';
Font.Size := 50;
Font.Color := clGray;
Font.Style := [fsBold];
TextOut((bm.Width - TextWidth('Text')) div 2,
(bm.Height - TextHeight('Text')) div 2, 'Text');
end;
Form1.Canvas.CopyMode := cmSrcPaint;
Form1.Canvas.CopyRect(bm.Canvas.ClipRect, bm.Canvas,
bm.Canvas.ClipRect);
bm.Destroy;
end;
Взято из
Вывод изображений
Вывод изображений
Вывод изображений
Заголовок HTTP-ответа для HTML-страниц
Мы уже знаем, что для сообщения браузеру, что передаваемый документ является HTML-документом, CGI-программа выводит специальный заголовок, не отображаемый браузером: WriteLn('Content-Type: text/html');
WriteLn('');
HTTP-заголовок для изображений
Точно таким же образом можно с успехом указать и другой тип данных! Например, для вывода изображения в формате GIF достаточно вывести следующее: WriteLn('Content-Type: image/gif');
WriteLn('');
Таким образом мы сообщаем браузеру, что далее будет следовать именно изображение...
Передача двоичных данных
Для начала давайте разберемся, как отправить двоичные данные в STDOUTPUT. Я написал две процедуры: первая выводит поток TSTREAM в STDOUTPUT, а вторая выводит двоичный файл в выходной поток:
// Процедура вывода потока в STDOUTPUT.
// Попробуйте самостоятельно переделать ее для Kylix...
procedure WriteStream(stream:TStream);
var
OutStream:THandleStream;
begin
Flush(output); // для передачи заголовка мы используем обычный WRITELN...
// здесь используется код из программы
// DCOUNTER for Delphi 3 by Dave Wedwick (dwedwick@bigfoot.com)
OutputStream:=THandleStream.Create(GetStdHandle(STD_OUTPUT_HANDLE));
Stream.SaveToStream(OutputStream);
OutputStream.Free;
end;
// Процедура для передачи двоичного файла
procedure WriteFile(FileName:string);
var
s:TFileStream;
begin
s:=TFileStream.Create(FileName,fmOpenRead);
WriteStream(s);
end;
Передача GIF файлов
Теперь нам осталось только создать (или взять готовый) GIF файл и вывести его! procedure WriteGIF(FileName:string);
begin
WriteLn('Content-type: image/gif');
WriteLn;
WriteFile(FileName);
end;
Вывод надписи на рабочий стол
Вывод надписи на рабочий стол
На рабочий стол можно вывести строку используя
TextOut(GetWindowDC(GetDesktopWindow),100,100,'Thom',4);
Автор ответа: Fantasist
Взято с Vingrad.ru
Поверх всех окон можно нарисовать надпись использую следующую процедуру:
procedure WriteDC(s: string);
var c: TCanvas;
begin
c := TCanvas.Create;
c.Brush.Color := clBlue;
c.Font.color := clYellow;
c.Font.name := 'Fixedsys';
c.Handle := GetDC(GetWindow(GetDesktopWindow, GW_OWNER));
c.TextOut(screen.Width - c.TextWidth(s) - 2, screen.Height - 43, s);
c.free;
end;
Автор ответа: Vit
Взято с Vingrad.ru
Вывод шрифтов в списке в виде самих шрифтов
Вывод шрифтов в списке в виде самих шрифтов
unitFontlist;
interface
uses
Windows, Classes, Graphics, Forms, Controls, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Label1: TLabel;
FontLabel: TLabel;
procedure FormCreate(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
procedure DrawItem(Control: TWinControl; index: Integer; Rect: TRect;
State: TOwnerDrawState);
procedure ListBox1MeasureItem(Control: TWinControl; index: Integer;
var Height: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
Listbox1.Items := Screen.Fonts;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
FontLabel.Caption := ListBox1.Items[ListBox1.ItemIndex];
end;
procedure TForm1.DrawItem(Control: TWinControl; index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
with ListBox1.Canvas do
begin
FillRect(Rect);
Font.name := ListBox1.Items[index];
Font.Size := 0; // use font's preferred size
TextOut(Rect.Left+1, Rect.Top+1, ListBox1.Items[index]);
end;
end;
procedure TForm1.ListBox1MeasureItem(Control: TWinControl; index: Integer;
var Height: Integer);
begin
with ListBox1.Canvas do
begin
Font.name := Listbox1.Items[index];
Font.Size := 0; // use font's preferred size
Height := TextHeight('Wg') + 2; // measure ascenders and descenders
end;
end;
end.
Взято из
Вывод текста на канве картинки
Вывод текста на канве картинки
При использовании BitBtn Caption(текст) и картинка(bitmap) из файла не видны одновременно. Почему?
Это может происходить если картинка слишком велика. Класс TBitBtn сначала рисует картинку, а затем выводит текст над, под, слева или справа от картинки (в завивимости от свойства Layout). Если размер картинки такой же как у всей кнопки для вывода текста просто не остается места. Если Вам нужно получить кнопку такого же размера как Ваша картинка и видеть при этом надпись на кнопке Вам придется выводить текст надписи непосредственно на канву картинки.
var
bm : TBitmap;
OldBkMode : integer;
begin
bm := TBitmap.Create;
bm.Width := BitBtn1.Glyph.Width;
bm.Height := BitBtn1.Glyph.Height;
bm.Canvas.Draw(0, 0, BitBtn1.Glyph);
OldBkMode := SetBkMode(bm.Canvas.Handle, Transparent);
bm.Canvas.TextOut(0, 0, 'The Caption');
SetBkMode(bm.Canvas.Handle, OldBkMode);
BitBtn1.Glyph.Assign(bm);
end;
Взято из
Вывод текста с эффектами
Вывод текста с эффектами
How to make TextOut with 3d-Effect or hollow Text
Answer:
Make a new Application and take this Proc bellow for the OnPaint-Event of the Form. The TextOutput will look like written with a kaligraf.If You replace the for loop in the proc with a single call of textout you can use this code to write "hollow" text. Try it with different Pen-Styles too!
procedureTForm1.FormPaint(Sender: TObject);
var
HFnt: HFONT;
Fontname, Txt: PChar;
sze: Size;
c: Integer;
byt: Byte;
begin
Fontname := 'Arial';
txt := 'Mediakueche';
HFnt := CreateFont(90, 60, 0, 0, FW_BOLD, 0, 0, 0, DEFAULT_CHARSET,
OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
PROOF_QUALITY, DEFAULT_PITCH + FF_DONTCARE, Fontname);
SelectObject(Canvas.Handle, hfnt);
SetBkMode(Canvas.Handle, TRANSPARENT);
GetTextExtentPoint32(Canvas.Handle, txt, length(txt), sze);
BeginPath(Canvas.Handle);
c := 1;
for c := 0 to 4 do
begin
TextOut(Canvas.Handle, 5 + c, 10 + c, Txt, length(Txt));
end;
EndPath(Canvas.Handle);
// Canvas.pen.Style := psDot;
StrokePath(Canvas.Handle);
SetBkMode(Canvas.Handle, OPAQUE);
DeleteObject(SelectObject(Canvas.Handle, GetStockObject(WHITE_BRUSH)));
SelectObject(Canvas.Handle, GetStockObject(SYSTEM_FONT));
DeleteObject(HFnt);
end;
Взято с
Delphi Knowledge Base Выводим цветной текст на форме под любым углом
Выводим цветной текст на форме под любым углом
Автор: Lutfi Baran
Пример демонстрирует вывод теста случайным образом на форме под определённым углом. Добавляем в форму компонент TButton и в событие OnClick следующий код:
procedure TForm1.Button1Click(Sender: TObject);
var
logfont: TLogFont;
font: Thandle;
count: integer;
begin
LogFont.lfheight := 20;
logfont.lfwidth := 20;
logfont.lfweight := 750;
LogFont.lfEscapement := -200;
logfont.lfcharset := 1;
logfont.lfoutprecision := out_tt_precis;
logfont.lfquality := draft_quality;
logfont.lfpitchandfamily := FF_Modern;
font := createfontindirect(logfont);
Selectobject(Form1.canvas.handle, font);
SetTextColor(Form1.canvas.handle, rgb(0, 0, 200));
SetBKmode(Form1.canvas.handle, transparent);
for count := 1 to 100 do
begin
canvas.textout(Random(form1.width), Random(form1.height), 'Hello');
SetTextColor(form1.canvas.handle, rgb(Random(255), Random(255), Random
(255)));
end;
Deleteobject(font);
end;
Взято с Исходников.ru
Вызов c-шной функции с переменным числом параметров
Вызов c-шной функции с переменным числом параметров
Автор: Владимир Переплетчик
Комментарий к статье по поводу wsprintf
Сама по себе статья вызывает мало интереса, кроме того, что поднята интересная проблема - вызов с-шной функции с переменным числом параметров. В ответах с использованием массивов вообще, IMHO, ошибка - на стек попадет адрес массива, а в с это совсем не то. Но решение проблемы существует, правда надо ручками повозиться со стеком. Приводимая ниже функция на скорую руку переделывается из работающей в реальном проекте похожего буфера с-паскаль, но там функция в dll имеет тип вызова cdecl и другие обязательные параметры, в связи с чем возможны "опечатки"
//Пишем функцию-переходник, маскируя с-шные "..." паскалевским
// array of const
function sprintf(out, fmt: Pchar; args: array of const): Integer;
var
I: Integer;
BufPtr: Pchar;
S: string;
buf: array[0..1024] of char;
begin
BufPtr := buf;
// Формируем буффер параметров. Можно, конечно, и прямо на стеке,
// но головной боли слишком много - проще так
for I := low(Par) to High(Par) do
case Par[I].VType of
vtInteger: // Здесь все просто - 4 байта на стек
begin
Integer(Pointer(BufPtr)^) := Par[I].VInteger;
Inc(BufPtr, 4);
end;
vtExtended: // Здесь хуже - слова надо местами поменять :-((
begin
Integer(Pointer(BufPtr)^) :=
Integer(Pointer(Pchar(Par[I].VExtended) + 4)^);
Inc(BufPtr, 4);
Integer(Pointer(BufPtr)^) :=
Integer(Pointer(Par[I].VExtended)^);
Inc(BufPtr, 4);
end;
vtPChar: // Здесь тоже все хорошо - 4 байта
begin
Pointer(Pointer(BufPtr)^) := Par[I].VPchar;
Inc(BufPtr, 4);
end;
vtString, vtAnsiString: // А здесь во избежание чудес надо
// копию строки снять
begin
if Par[I].VType = vtString then
S := Par[I].VString^
else
S := string(Par[I].VAnsiString);
Pointer(Pointer(BufPtr)^ :=
StrPCopy(StrAlloc(Length(S) + 1), S);
Inc(BufPtr, 4);
end;
end;
// Поддержку других типов доделывать самостоятельно,
// вооружившись толковым пособием по с и ассемблеру
I := (BufPtr - buf) div 4; // Сколько раз на стек слово положить
asm
push dword ptr [out]
push dword ptr [fmt]
mov ecx, dword ptr [i]
mov eax, dword ptr [buf] // stdcall - параметры в прямом
// порядке
@@1:
push dword ptr [eax]
add eax, 4
loop @@1
call [wsprintf]
mov dword ptr [Result], eax // Сохранить результат
mov eax, dword ptr [i] // Привести в порядок стек
shl eax, 2
add eax, 8
add esp, eax
end;
// Почистить строки
for I := low(Par) to High(Par) do
case Par[I].VType of
vtInteger: Inc(BufPtr, 4);
vtExtended: Inc(BufPtr, 8);
vtPChar: Inc(BufPtr, 4);
vtString, vtAnsiString:
begin
StrDispose(PChar(PPointer(BufPtr)^));
Inc(BufPtr, 4);
end;
end;
end;
В таком виде методика уже имеет смысл. Изменения при типах вызова cdecl / pascal понятны.
Взято с
Вызов Delphi DLL из MS Visual C++
Вызов Delphi DLL из MS Visual C++
Во-первых, Вам необходимо объявить все экспортируемые в Delphi DLL функции с ключевыми словами export; stdcall;
Во-вторых, файл заголовка VC++ должен объявить все функции как тип __declspec(dllexport) __stdcall (применяйте двойное подчеркивание в секции объявления прототипа функции extern "C" { ... }. (вместо этого можно также использовать __declspec(dllimport)...). Для примера:
extern"C" {
int __declspec(dllexport) __stdcall plusone(int); }
В-третьих, в VC++ компилятор настраивается на "украшающее" имена функций __stcall, так что Ваша Delphi DLL соответственно должна экспортировать эти функции. Для этого необходимо модифицировать файл Delphi 2.0 .DPR для Вашего DLL, модифицируя имена всех функций, прописанных в разделе экспорта. Для примера, если Вы экспортируете функцию function plusone (intval : Integer), Вам необходимо включить следующую строку в раздел экспорта .DPR-файла:
plusone name 'plusone@4'
Число, следующее за символом @, является общей длиной в байтах всех функциональных аргументов. Самый простой путь для обнаружения неправильных значений - попытаться слинковать Вашу VC++ программу и посмотреть на наличие возможной ошибки компоновщика "unresolved external".
И, наконец, Вы можете легко создать библиотеку импорта, используя утилиту LIB из поставки VC++. Для этого необходимо вручную (!!) создать .DEF-файл для Вашей DLL с секцией экспорта, перечисляющей имена и/или порядковые номера всех экспортируемых DLL функций. Формат .DEF-файла очень прост:
library MYLIB
description 'Моя собственная DLL'
exports
plusone@4
Затем запускаете LIB из командной строки DOS/Win95, и в качестве параметра подставляете имя .DEF-файла. Например, LIB /DEF:MYDLL.DEF. Наконец, через диалог Build|Settings|Linker Вы информируете VC++ о полученном .LIB-файле.
Вот пример кода:
*******MYDLLMU.PAS
unit MyDLLMU;
interface
function plusone(val : Integer) : Integer; export; stdcall;
procedure ChangeString(AString : PChar); export; stdcall;
implementation
uses
Dialogs,
SysUtils;
function plusone(val : Integer) : Integer;
begin
Result := val + 1;
end;
procedure ChangeString(AString : PChar);
begin
if AString = 'Здравствуй' then
StrPCopy(AString, 'Мир');
end;
end.
***********MYDLL.DPR
library mydll;
{ Существенное замечание об управлении памятью в DLL: Если DLL экспортирует функции со
строковыми параметрами или возвращающие строковые значения, модуль ShareMem надо
указывать в разделе Uses библиотеки и проекта первым. Это касается любых строк,
передаваемых как в DLL, так и из нее, даже если они размещаются внутри записей или
объектов. Модуль ShareMem служит интерфейсом менеджера разделяемой памяти
DELPHIMM.DLL, который должен разворачиваться одновременно с данной DLL. Чтобы избежать
применения DELPHIMM.DLL, строковую информацию можно передавать с помощью параметров
типа PChar или ShortString. }
uses
SysUtils,
Classes,
MyDLLMU in 'MyDLLMU.pas';
exports
plusone name 'plusone@4',
ChangeString name 'ChangeString@4';
begin
end.
*************** MYDLL.DEF
; -----------------------------------------------------------------
; Имя файла: MYDLL.DEF
; -----------------------------------------------------------------
LIBRARY MYDLL
DESCRIPTION 'Тестовая Delphi DLL, статическая загрузка в VC++ приложение'
EXPORTS
plusone@4
************** DLLTSTADlg.H
// DLLTSTADlg.h : заголовочный файл
//
#define USELIB
#ifdef USELIB
extern "C" {
int __declspec(dllimport) __stdcall plusone(int);
}
#endif //USELIB
/////////////////////////////////////////////////////////////////////////////
// Диалог CDLLTSTADlg
class CDLLTSTADlg : public CDialog
{
// Создание public:
CDLLTSTADlg(CWnd* pParent = NULL); // стандартный конструктор
~CDLLTSTADlg();
// Данные диалога
//{{AFX_DATA(CDLLTSTADlg)
enum { IDD = IDD_DLLTSTA_DIALOG };
CString m_sVal;
CString m_sStr;
//}}AFX_DATA
// Перекрытая виртуальная функция, сгенерированная ClassWizard
//{{AFX_VIRTUAL(CDLLTSTADlg)
protected:
virtual void DoDataExchange(CDataExchange* pDX); // Поддержка DDX/DDV
//}}AFX_VIRTUAL
// Реализация
protected:
#ifndef USELIB
HINSTANCE hMyDLL;
FARPROC lpfnplusone;
typedef int (*pIIFUNC)(int);
pIIFUNC plusone;
#endif //USELIB
HICON m_hIcon;
// Карта функций генераций сообщений
//{{AFX_MSG(CDLLTSTADlg)
virtual BOOL OnInitDialog();
afx_msg void OnPaint();
afx_msg HCURSOR OnQueryDragIcon();
afx_msg void OnBtnplusone();
afx_msg void OnBtnplusoneClick();
afx_msg void OnBtndostringClick();
//}}AFX_MSG
DECLARE_MESSAGE_MAP()
};
************ DLLTSTADlg.CPP
// DLLTSTADlg.cpp : файл реализации
//
#include "stdafx.h"
#include "DLLTSTA.h"
#include "DLLTSTADlg.h"
#ifdef _DEBUG
#define new DEBUG_NEW
#undef THIS_FILE
static char THIS_FILE[] = __FILE__;
#endif
extern CDLLTSTAApp theApp;
/////////////////////////////////////////////////////////////////////////////
// Диалог CDLLTSTADlg
CDLLTSTADlg::CDLLTSTADlg(CWnd* pParent /*=NULL*/)
: CDialog(CDLLTSTADlg::IDD, pParent)
{
//{{AFX_DATA_INIT(CDLLTSTADlg)
m_sVal = _T("1");
m_sStr = _T("Hello");
//}}AFX_DATA_INIT
// Имейте в виду, что в Win32 LoadIcon не требует последующего DestroyIcon
m_hIcon = AfxGetApp()->LoadIcon(IDR_MAINFRAME);
#ifndef USELIB
hMyDLL = LoadLibrary("C:\\delpwork\\MYDLL.DLL");
if(hMyDLL == NULL)
PostQuitMessage(1);
lpfnplusone = GetProcAddress(HMODULE(hMyDLL), "_plusone");
if(lpfnplusone == NULL)
PostQuitMessage(2);
plusone = pIIFUNC(lpfnplusone);
#endif //USELIB
}
CDLLTSTADlg::~CDLLTSTADlg()
{
#ifndef USELIB
if (hMyDLL != NULL)
FreeLibrary(hMyDLL);
#endif //USELIB
}
void CDLLTSTADlg::DoDataExchange(CDataExchange* pDX)
{
CDialog::DoDataExchange(pDX);
//{{AFX_DATA_MAP(CDLLTSTADlg)
DDX_Text(pDX, IDC_LBLINT, m_sVal);
DDX_Text(pDX, IDC_LBLSTRING, m_sStr);
//}}AFX_DATA_MAP
}
BEGIN_MESSAGE_MAP(CDLLTSTADlg, CDialog)
//{{AFX_MSG_MAP(CDLLTSTADlg)
ON_WM_PAINT()
ON_WM_QUERYDRAGICON()
ON_BN_CLICKED(IDC_BTNPLUSONE, OnBtnplusoneClick)
ON_BN_CLICKED(IDC_BTNDOSTRING, OnBtndostringClick)
//}}AFX_MSG_MAP
END_MESSAGE_MAP()
/////////////////////////////////////////////////////////////////////////////
// Дескрипторы сообщений CDLLTSTADlg
BOOL CDLLTSTADlg::OnInitDialog()
{
CDialog::OnInitDialog();
// Устанавливаем иконку для данного диалога. В случае, когда главное
// окно программы не является диалогом, это происходит автоматически
SetIcon(m_hIcon, TRUE); // Устанавливаем большую иконку
SetIcon(m_hIcon, FALSE); // Устанавливаем маленькую иконку
// TODO: Здесь добавляем дополнительную инициализацию
return TRUE; // возвращает TRUE в случае отсутствия фокуса у диалога
}
// Если Вы добавляете в диалог кнопку минимизации, для создания иконки Вам
// необходим код, приведенный ниже. Для MFC-приложений используйте
// document/view model для автоматического создания скелета кода.
void CDLLTSTADlg::OnPaint()
{
if (IsIconic())
{
CPaintDC dc(this); // контекст устройства для рисования
SendMessage(WM_ICONERASEBKGND, (WPARAM) dc.GetSafeHdc(), 0);
// Центр иконки в области клиента
int cxIcon = GetSystemMetrics(SM_CXICON);
int cyIcon = GetSystemMetrics(SM_CYICON);
CRect rect;
GetClientRect(&rect);
int x = (rect.Width() - cxIcon + 1) / 2;
int y = (rect.Height() - cyIcon + 1) / 2;
// Рисование иконки
dc.DrawIcon(x, y, m_hIcon);
}
else
{
CDialog::OnPaint();
}
}
// Система вызывает данный код для получения курсора, выводимого если
// пользователь пытается перетащить свернутое окно.
HCURSOR CDLLTSTADlg::OnQueryDragIcon()
{
return (HCURSOR) m_hIcon;
}
void CDLLTSTADlg::OnBtnplusoneClick()
{
int iTemp;
char sTemp[10];
iTemp = atoi(m_sVal);
iTemp = plusone(iTemp);
m_sVal = itoa(iTemp, sTemp, 10);
UpdateData(FALSE);
}
void CDLLTSTADlg::OnBtndostringClick()
{
UpdateData(FALSE);
}
Во-первых, создайте в Delphi простую DLL:
{ Начало кода DLL }
library MinMax;
function Min(X, Y: Integer): Integer; export;
begin
if X < Y then
Min := X
else
Min := Y;
end;
function Max(X, Y: Integer): Integer; export;
begin
if X > Y then
Max := X
else
Max := Y;
end;
exports
Min index 1,
Max index 2;
begin
end.
{ Конец кода DLL }
Затем, для вызова этих функций из вашего C кода, сделайте следующее:
В вашем .DEF-файле добавьте следующие строки:
IMPORTS
Min =MINMAX.Min
Max =MINMAX.Max
Объявите в вашем C-приложени прототип функций, как показано ниже:
int FAR PASCAL Min(int x, y);
int FAR PASCAL Min(int x, y);
Теперь из любого места вашего приложения вы можете вызвать функции Min и Max.
Взято с
Вызов процедуры, имя которой содержится в переменной
Вызов процедуры, имя которой содержится в переменной
Как я могу вызвать процедуру, чье имя хранится в таблице, списке, и т.п.? Другими словами, я хочу сохранить имя процедуры в переменной и для ее вызова обращаться к значению этой переменной. Какие предложения?
unitProcDict;
interface
type MyProc = procedure(s: string);
procedure RegisterProc(procName: string; proc: MyProc);
procedure ExecuteProc(procName: string; arg: string);
implementation
uses Classes;
var ProcDict: TStringList;
procedure RegisterProc(procName: string; proc: MyProc);
begin
ProcDict.AddObject(procName, TObject(@proc));
end;
procedure ExecuteProc(procName: string; arg: string);
var
index: Integer;
begin
index := ProcDict.IndexOf(ProcName);
if index >= 0 then
MyProc(ProcDict.objects[index])(arg);
// Можно вставить обработку исключительной ситуации - сообщение об ошибке
end;
initialization
ProcDict := TStringList.Create;
ProcDict.Sorted := true;
finalization
ProcDict.Free;
end.
вы могли бы создать StringList как показано ниже:
StringList.Create; StringList.AddObject('Proc1',@Proc1);
StringList.AddObject('Proc2',@Proc2);
и затем реализовать это в вашей программе:
var
myFunc: procedure;
begin
if Stringlist.indexof(S) = -1 then
MessageDlg('Не понял процедуру ' + S, mtError, [mbOk], 0)
else
begin
@myFunc := Stringlist.Objects[Stringlist.indexof(S)];
myFunc;
end;
RAM
Взято из
Советов по Delphi от
Сборник Kuliba
Взаимодействие с чужими окнами
Взаимодействие с чужими окнами
Представьте себе, глупый пользователь сидит как ни в чём небывало с умным видом уже в какой раз пытается составить документ в Microsoft Word'e, но вдруг окно начинает бешено скакать по экрану, в его заголовке выводятся непристойные сообщения, оно то сворачивается, то разворачивается, меняя постоянно свои размеры, а под конец совсем исчезает, унося в небытиё весь текст, который с таким трудом набил ламерюга... а если так себя в любой момент может повести любая программа... впечатления от этого останутся на долго!!!
Для того, чтобы сделать что-нибудь над каким-либо окном нужно сначала получить его дескриптор, т.е. его положение в оперативной памяти. Для этого нужно использовать функцию FindWindow. Ей нужно указать всего два параметра: сначала класс искомого окна, затем его заголовок. Ну с заголовком проблем вообщем-то нет - его мы видим, но вот как определить класс... ведь он скрыт от глас пользователя. В действительности мы может указать только заголовок окна, а вместо класса ставим nil.
Для начала запустите стандартную программу "Блокнот" - и что же мы видим? В блокноте в заголовке окна отслеживается имя текущего файла. Изначально, т.к. файла нет в использовании, заголовок блокнота выглядит так: "Безымянный - Блокнот". Постараемся по этому критерию найти окно блокнота. Выглядеть это будет так:
ifFindWindow(nil, 'Безымянный - Блокнот') <> 0 then
ShowMessage('Окно найдено')
else
ShowMessage('Окно НЕнайдено');
Как мы видим из кода, если наша программа найдёт окно блокнота, мы увидим сообщение, гласящее об этом.
Далее попробуем передвинуть это окно
var
h: HWND;
begin
h := findwindow(nil, 'Безымянный - Блокнот');
if h <> 0 then
SetWindowPos(h, HWND_BOTTOM, 1, 1, 20, 20, swp_nosize);
end;
Опять находим блокнот. Его дескриптор помещаем в переменную класса HWND[С английского Handle Window - дескриптор окна]. Далее используем функцию SetWindowPos для задания позиции. В качестве параметров нужно указать:
Дескриптор окна, которое хотим переместить
Идентификатор окна, которое предшествует перемещаемому окну в Z-последовательности. Z-последовательность это порядок, в котором формировались окна. Данный параметр указывает с какого именно окна необходимо начинать писк. В качестве значений может принимать либо дескриптор какого-либо окна в системе, либо одно из нижеследующих значений:
HWND_BOTTOM Начало Z-последовательности
HWND_NOTOPMOST Первое окно которое располагается не "поверх все окон"
HWND_TOP Вершина Z-последовательности
HWND_TOPMOST Первое окно которое располагается "поверх все окон"
Позиция окна по горизонтали
Позиция окна по вертикали
Ширина окна
Высота окна
Спецификаторы изменения позиции и размеров окна[флаги]. Для задания значения можно комбинировать следующие константы
SWP_DRAWFRAME Прорисовка фрейма вокруг окна.
SWP_FRAMECHANGED Посылает сообщение WM_NCCALCSIZE окну, даже если размер его не был изменён. Если этот флаг не указан, сообщение WM_NCCALCSIZE будет посылаться, только после изменения размеров окна.
SWP_HIDEWINDOW Скрывает окно.
SWP_NOACTIVATE Не активизирует окно. Если же этот флаг не будет поставлен, окно активизируется и будет перемещено поверх всех окон. А вот встанет ли окно даже выше тех окон, которым задано HWND_TOPMOST или нет зависит от параметра hWndInsertAfter.
SWP_NOCOPYBITS Если этот спецификатор не будет установлен, тогда содержимое клиентской области окна будет скопировано и вставлено во вновь отобразившееся окно после его перемещения.
SWP_NOMOVE Сообщает, что нужно игнорировать параметры задания позиции окну.
SWP_NOOWNERZORDER Сообщает, что не следует изменять позицию окна владельца в Z-последовательности.
SWP_NOREDRAW Не перерисовывает окно.
SWP_NOREPOSITION Такой же как и SWP_NOOWNERZORDER.
SWP_NOSENDCHANGING Мешает окну получить сообщение WM_WINDOWPOSCHANGING.
SWP_NOSIZE Сообщает, что нужно игнорировать параметры задания размеров окну.
SWP_NOZORDER Сохраняет текущее положение в Z-последовательности (игнорирует сообщение hWndInsertAfter parameter).
SWP_SHOWWINDOW Отображает окно.
Если данная функция выполнится успешно, она возвратит отличное от нуля значение. Ну, вот, теперь мы можем передвигать и изменять в размерах чужие окна!!! Для того, чтобы изменить заголовок окна напишем следующий код:
SetWindowText(FindWindow(nil, 'Безымянный - Блокнот'),
'Дарова, ламерюга, типа ты попал... ');
Функции setwindowtext нужно указать только два параметра: это дескриптор нужного окна и новое значение для заголовка. Вот вообщем-то и всё!
Есть ещё одна интересная функция ShowWindow, которая позволяет скрывать или отображать окна. Использовать её нужно так::
ShowWindow(FindWindow(nil, 'Безымянный - Блокнот'), sw_hide);
В скобках указываем сначала над каким именно окном хотим издеваться, а затем что именно мы хотим с ним сделать. В качестве возможных действий можем указать:
SW_HIDE Скрывает окно и активизирует другое.
SW_MAXIMIZE Разворачивает окно.
SW_MINIMIZE Сворачивает окно.
SW_RESTORE Активизирует и выводит окно. Если окно было развёрнуто или свёрнуто - восстанавливает исходный размер и позицию.
SW_SHOW Активизирует и выводит окно с его оригинальным размером и положением.
SW_SHOWDEFAULT Активизирует с установками, заданными в структуре STARTUPINFO, которая была передана при создании процесса приложением запускающим нужную программу.
SW_SHOWMAXIMIZED Выводит окно в развёрнутом виде.
SW_SHOWMINIMIZED Выводит окно в виде пиктограммы на панели задач.
SW_SHOWMINNOACTIVE Выводит окно в свёрнутом виде на панели задач и не передаёт ему фокус ввода, т.е. окно, которое до этого было активно остаётся активно по прежнему.
SW_SHOWNA Отображает окно в его текущем состоянии. Активное окно остаётся активным по прежнему.
SW_SHOWNOACTIVATE Выводит окно в его последнем положении и с последними используемыми размерами. Активное окно остаётся активным по прежнему.
SW_SHOWNORMAL Выводит окно. Если оно было свёрнуто или развёрнуто - восстанавливает его оригинальные размеры и позицию
Но вся сложность действий заключается в том, что в заголовке Блокнота отслеживается имя текущего файла и использовать значение "Безымянный - Блокнот" мы можем не всегда : (. Тем более это не только в случае с блокнотом... Но есть выход: ведь функции FindWindow для поиска окна мы указываем не только заголовок нужного окна, но ещё его класс. Какой же это выход скажете вы, заголовок окна мы видим, значит знаем, что указывать - а класс окна... в действительности тоже может найти приложив немного усилий!
В пакет Delphi входим специальная утилита для отслеживание всех активных процессов, она называется WinSight32. Вот ею мы и воспользуемся. Запустите её, покопайтесь в списке процессов, ищите строку где значится текущий заголовок нужного окна, например Блокнота, и в левой части этой строки в фигурных скобках вы найдёте имя класса окна. Для блокнота это будет "Notepad". Теперь зная имя класса окна мы можем переписать поиск окна таким способом:
ShowWindow(FindWindow('Notepad', nil), sw_hide);
Теперь мы вместо заголовка окна указываем значение nil, игнорируя данный параметр.
Есть ещё один замечательный способ передачи команд окнам.- функция PostMessage. Ей в качестве параметров нужно указать:
Дескриптор окна, которому посылается сообщение или следующие значения:
HWND_BROADCAST Сообщение будет послано всем окнам верхнего уровня системы, включая неактивные и невидимые окна, overlapped-окна, и PopUp-окна, но сообщение не будет посылаться дочерним[Child] окнам.
NULL Ведёт себя как функция PostThreadMessage с переданным ей dwThreadId параметром.
Посылаемое сообщение
Первый параметр сообщения
Второй параметр сообщения
Например, если послать сообщение wm_quit блокноту - окно будет закрыто без вывода всяких сообщений о необходимости сохранения!
PostMessage(FindWindow('Notepad', nil), wm_quit, 0, 0);
Взято с
Взаимодействие с другими языками
Взаимодействие с другими языками
Cодержание раздела:
См. также статьи в других разделах:
Взаимодействие с системой: Linux API и Qt library
Взаимодействие с системой: Linux API и Qt library
Автор: Андрей Боровский ()
В процессе разработки приложений в средах Delphi и Kylix время от времени возникает необходимость в обращении непосредственно к прикладному интерфейсу системы. Это происходит по двум причинам: во-первых, несмотря на широчайший выбор компонентов, библиотека VCL/CLX не в состоянии охватить все возможности, предоставляемые операционной системой. Во-вторых, даже в том случае, когда среда разработки предоставляет готовый компонент, обладающий соответствующей функциональностью, в целях повышения быстродействия имеет смысл использовать системные функции, лежащие в основе компонента.
В Delphi интерфейсы большинства системных функций определены в библиотеках времени выполнения (run-time libraries), а для упрощения реализации недостающих интерфейсов в язык Object Pascal введены элементы, облегчающие "перевод" деклараций функций и объектов с С++ на Object Pascal и взаимодействие с системными библиотеками. Фактически, можно утверждать, что интерфейс Win32 API полностью доступен в Delphi.
Разработчики Kylix также постарались сделать интерфейс системы Linux максимально доступным в среде Object Pascal. Однако, при программировании в Kylix, непосредственное взаимодействие с системой осуществляется несколько сложнее, чем в Delphi и Windows.
Прежде всего, следует учесть, что Linux не так "монолитна", как Windows. То, что мы дальше будем называть "интерфейсом системы" состоит из нескольких независимых друг от друга частей. В Linux графическая подсистема отделена от остальной операционной системы и в принципе эта 32-х разрядная многозадачная ОС может использоваться вообще без графического интерфейса. У такого подхода есть свои преимущества: при решении ресурсоемких задач вся мощность процессора может быть брошена на выполнение полезной работы, а не затрачиваться на перерисовку окон. Кроме того приложениям с текстовым интерфейсом присуща большая стабильность. Работа с графикой в Linux осуществляется на основе сервера XFree86. Эта графическая подсистема предоставляет в распоряжение программиста интерфейсы для выполнения базовых операций, необходимых для построения графического интерфейса пользователя и вывода графической информации. При решении большинства задач у программиста не возникает необходимости писать код, взаимодействующий непосредственно с XFree86. Дело в том, что над XFree86 существует несколько "надстроек", облегчающих работу с графикой и построение пользовательского интерфейса. Одной из таких надстроек является библиотека Qt library, на базе которой реализована графическая оболочка KDE. Qt library является также основой набора компонентов VisualCLX, - аналога VCL для Kylix. Следует отметить, что библиотека Qt реализована не только на Linux. Существуют версии Qt для Mac OS, Solaris и даже для Windows. Ожидается, что поддержка Qt будет введена в Delphi 6.0, что в свою очередь еще больше упростит перенос приложений между Kylix и Delphi.
В Kylix большая часть системных функций Linux инкапсулирована в модулях System, SysUtils и т. д., а большинство возможностей Qt library реализовано в наборе компонентов VisualCLX. Кроме этого Kylix предоставляет программисту возможность непосредственной работы как с интерфейсами Linux, так и с классами библиотеки Qt. Далее мы рассмотрим эти возможности подробнее.
Kylix и Linux API
Импортирование функций Linux API осуществляется достаточно просто и очень похоже на импортирование функций из Windows DLL. В Linux аналогом DLL являются разделяемые библиотеки (shared object files, so files). Обычно имена файлов разделяемых библиотек включают расширение .so. Не следует путать эти файлы с файлами объектного кода. Модули времени выполнения Kylix импортируют многие функции Linux API. Например, модуль Libc импортирует функции glibc - GNU C library. Между именами функций glibc и их декларациями в Libc существует четкое соответствие, так что для изучения функций модуля Libc можно воспользоваться документацией по glibc и страницами man. Между прочим, если в окне редактора кода поместить курсор на имя glibc функции и нажать F1, будет открыто не окно справки Kylix, а соответствующая man-страница.
Рассмотрим, например, glibc функцию fork, которая создает в системе новый процесс, являющийся точной копией того процесса, из которого вызвана эта функция. В glibc данная функция определена следующим образом:
pid_tfork (void);
В модуле Libc декларация этой функции выглядит так:
function fork: __pid_t; cdecl;
Обратите внимание на указание формата вызова cdecl. Этот формат используется по умолчанию для вызова системных функций Linux, также как в Delphi для вызова функций Win32 API используется stdcall.
Вы сами можете импортировать функции из разделяемых библиотек. В следующем примере осуществляется импортирование функции vga_setmode из библиотеки VGAlib (разделяемый файл libvga.so). В заголовке библиотеки, написанной на С, эта функция объявляется как
int vga_setmode (int mode);
В модуле Kylix пишем:
…
interface
function SetVGAMode (Mode: Integer) : Integer; cdecl;
…
implementation
function SetVGAMode; external 'libvga.so' name 'vga_setmode';
…
Интеграция кода, написанного на C/C++, и Kylix-приложений будет рассмотрена подробнее в следующих статьях.
Kylix и Qt library
Библиотека Qt library является основой библиотеки VisualCLX точно также, как Windows GUI API является основой Delphi VCL. Большинство компонентов VisualCLX можно рассматривать как "Object Pascal оболочки" соответствующих объектов Qt library.
Однако механизм взаимодействия между VisualCLX и Qt library сложнее, чем механизм взаимодействия между VCL и Windows GUI API. На рисунке справа показаны различные уровни интерфейсов между XFree86 и VisualCLX. На схеме видно, что между VisualCLX и Qt library лежит "прослойка" CLXDisplay API. Необходимость в этой "прослойке" вызвана тем, что Qt library - это не набор функций, а иерархия классов С++. В Object Pascal не существует возможности импортировать классы С++ непосредственно, и разработчикам Kylix пришлось пойти в обход этой проблемы.
Идея CLXDisplay API заключается в трансляции методов классов в функции. (Говоря о классах, я буду использовать терминологию Object Pascal, а не С++). Для обращения к какому-либо методу экземпляра класса Qt library вызывается соответствующая функция, которой в качестве одного из параметров передается указатель на экземпляр класса, для которого должен быть вызван данный метод.
Поясним вышесказанное на простом примере: Допустим, в библиотеке, написанной на С++, реализован класс QSomeClass. У этого класса есть конструктор, деструктор и метод Method1. Для того, чтобы сделать методы класса С++ доступными в Object Pascal, мы пишем на С++ библиотеку-оболочку для данного класса, экспортирующую функции QSomeClass_Create, QSomeClass_Destroy и QSomeClass_Method1. Теперь, для того, чтобы в программе, написанной на Object Pascal, создать экземпляр класса QSomeClass, мы вызываем функцию QSomeClass_Create, и передаем ей в качестве параметров значения, требующиеся конструктору класса. Написанная на С++ функция QSomeClass_Create создает экземпляр класса QSomeClass и передает значения своих параметров его конструктору. В качестве результата функция возвращает некий идентификатор созданного экземпляра, например, указатель на него. Таким образом мы можем создать несколько экземпляров класса QSomeClass. Если теперь мы хотим вызвать метод Method1 для одного из экземпляров QSomeClass, мы вызываем функцию QSomeClass_Method1, передавая ей в качестве одного из параметров значение, возвращенное функцией QSomeClass_Create. Оболочка класса вызывает метод Method1 для экземпляра, соответствующего переданному идентификатору, передает этому методу необходимые параметры и затем, если нужно, возвращает значение, возвращенное методом Method1. Для уничтожения экземпляра QSomeClass вызывается функция QSomeClass_Destroy, которой передается идентификатор этого экземпляра.
Таким образом можно сказать, что CLXDisplay API представляет собой набор функций, "деклассирующих" библиотеку Qt library. Для упрощения работы с этим интерфейсом имена функций строятся по определенной системе. Рассмотрим для примера Qt класс QPushButton. Класс QPushButton реализует кнопку - элемент пользовательского интерфейса и является основой класса TButton из библиотеки VisualCLX. У класса QPushButton есть несколько конструкторов, деструктор и ряд методов, таких как SetDefault, IsDefault, SetFlat и т. д. Далее мы рассмотрим, какие функции для работы с этим классом предоставляет CLXDisplay API. Функции интерфейса CLXDisplay API объявляются в Kylix модуле Qt, который поставляется с исходным текстом. В комплект документации, поставляемой с Kylix, справочник по CLXDisplay API не входит, так что нашими главными источниками информации по этому вопросу будут файл Qt.pas из поставки Kylix и документация к Qt library.
Из файла qpushbutton.h, входящего в Qt library, явствует, что у класса QPushButton три конструктора:
QPushButton( QWidget *parent, const char *name=0 );
QPushButton( const QString &text, QWidget *parent, const char* name=0 );
QPushButton( const QIconSet& icon, const QString &text, QWidget *parent, const char* name=0 );
Каждому из этих конструкторов соответствует своя функция в модуле Qt:
function QPushButton_create(parent: QWidgetH; name: PAnsiChar): QPushButtonH; overload; cdecl;
function QPushButton_create(text: PWideString; parent: QWidgetH; name: PAnsiChar): QPushButtonH; overload; cdecl;
function QPushButton_create(icon: QiconSetH; text: PWideString; parent: QWidgetH; name: PAnsiChar): QPushButtonH; overload; cdecl;
Обратите внимание на спецификатор overload. В качестве префикса к имени функции используется имя класса, в данном случае QPushButton. Далее следует _create, означающее, что функция создает экземпляр класса и вызывает его конструктор. Все три функции возвращают значение типа QPushButtonH, которое является ссылкой на созданный экземпляр объекта. Это значение следует передавать другим функциям для работы с экземпляром QPushButton. Имя типа ссылки на экземпляр класса составляется из имени класса с добавлением H. Обратите внимание на переменную parent типа QWidgetH - эта переменная является ссылкой на экземпляр одного из потомков класса QWidget, базового класса Qt library. В этом параметре передается ссылка на экземпляр объекта пользовательского интерфейса, которому принадлежит создаваемая кнопка. В иерархии указателей действуют те же правила, что и в иерархии классов: переменной типа QWidgetH можно присваивать указатель на экземпляр любого класса-потомка QWidget. В переменной name передается имя экземпляра. Оно используется в некоторых средах разработки и для поиска экземпляра объекта в иерархии объектов. Вы можете присваивать этой переменной любое значение.
Для уничтожения экземпляра объекта QPushButton служит процедура QPushButton_destroy:
procedure QPushButton_destroy(handle: QPushButtonH); cdecl;
В качестве единственного параметра этой функции передается ссылка на экземпляр объекта, который нужно уничтожить. Для вызова метода SetFlat, отключающего или восстанавливающего вывод границы для неактивной кнопки, служит процедура QPushButton_setFlat:
procedure QPushButton_setFlat(handle: QPushButtonH; p1: Boolean); cdecl;
Для проверки того, является ли данная кнопка элементом управления, выбираемым по умолчанию предназначена функция
function QPushButton_isDefault(handle: QPushButtonH): Boolean; cdecl;
В начале этого раздела было отмечено, что в основе компонентов VisualCLX лежат классы Qt library. Можно ли получить доступ к экземпляру класса Qt, соответствующему данному экземпляру класса VisualCLX? VisualCLX предоставляет такую возможность. Для каждого класса VisualCLX определено свойство Handle, которое во время выполнения программы содержит ссылку на "нижележащий" класс Qt library. Эта ссылка позволяет вызывать методы класса Qt. Рассмотрим конкретный пример. Пусть при проектировании пользовательского интерфейса приложения в окне формы была создана кнопка - компонент класса TButton. Это означает, что в программу была введена переменная Button1 : TButton. Как и следовало ожидать, свойство Button1.Handle имеет тип QPushButtonH. Воспользуемся этим указателем для доступа к Qt объекту и сделаем данную кнопку элементом управления по умолчанию:
QPushButton_setDefault(Button1.Handle, True);
Конечно, тоже самое можно было бы сделать и при помощи свойства Default объекта Button1.
В заключение отмечу одну юридическую тонкость, касающуюся использования Qt и Kylix. Библиотека Qt library распространяется на основе двух типов лицензий: бесплатной и коммерческой. Если Вы получили Qt в составе дистрибутива Linux, значит Вы являетесь обладателем бесплатной лицензии. За коммерческую лицензию Вам придется заплатить дополнительно. Бесплатная лицензия дает Вам право на разработку Qt приложений при условии, что эти приложения будут распространяться на основе General Public License (GPL), т. е. вместе с исходным текстом. Для того, чтобы иметь право распространять Qt приложения на коммерческой основе, Вам потребуется коммерческая лицензия. Если Вы являетесь пользователем легальной копии Kylix, т. е. обладаете лицензией Borland, Вы имеете право создавать при помощи Kylix как открытые, так и коммерческие приложения, даже если у Вас нет коммерческой лицензии на использование Qt. Однако тут действуют некоторые ограничения:
Если Вы используете в коммерческом приложении элементы CLXDisplay API, Ваше приложения должно содержать экземпляр TApplication и хотя бы один компонент, являющийся производным от TControl. В противном случае Вы должны либо распространять приложение на основе GPL, либо приобрести коммерческую лицензию на использование Qt.
Если в создаваемом приложении Вы используете Qt-функциональность, не связанную с CLXDisplay API, (например, взаимодействуя непосредственно с С++ модулями Qt), Вы также должны либо сделать приложение открытым, либо приобрести коммерческую Qt лицензию.
Есть, конечно, и третий путь - просто наплевать на все лицензии, однако я Вам этот вариант не советую.
В этой статье была описана работа с Linux API и вызовы методов объектов Qt library из программы, написанной на Object Pascal. Однако, для того, чтобы воспользоваться мощью Qt в полной мере, необходимо также уметь создавать свои обработчики событий Qt library. О том, как это сделать, будет рассказано в следующей статье.
Статья и примеры программ © 2001 Андрей Наумович Боровский.
Взято с Исходников.Ru
Взаимодействие с Win16 кодом
Взаимодействие с Win16 кодом
Cодержание раздела:
Взаимодействуем с Winamp
Взаимодействуем с Winamp
О пользе плагинов и спорить не приходиться. Потому многие крупные разработчики программного обеспечения предусматривают в своих творениях поддержку модулей, написанных другими людьми. Так поступила и компания Nullsoft, создатель известного компьютерного плеера - Winamp. Для непосредственного обращения к плееру были созданы специальные функции - WinampApi.
Алгоритм взаимодействия таков:
Находим Handle окна Winamp'a. (можно так - findwindow('Winamp v1.x',nil) )
С помощью команды Sendmessage, посылаем окну сообщение вида WM_COMMAND или WM_USER c определёнными параметрами (см. Приложение)
Итак, напишем, например, процедуру для проигрывания заданного трека с заданной громкостью. В дальнейшем, её можно будет использовать в плагине или в программе, работающей совместно с Winamp.
procedureplay_track_with_volume(track_number:integer;volume:integer);
// Track_number - номер трека (от 1 до величины количества треков)
// Volume - громкость (от 0 до 255)
var
h: hwnd;
begin
h:=findwindow('Winamp v1.x',g>nil); // Находим окно
sendmessage(h,WM_USER,track_number-1,121); // Устанавливаем номер трека
sendmessage(h,WM_USER,volume,122); // Устанавливаем громкость
sendmessage(h,WM_COMMAND,40045,0); // Проигрываем трек
end;
Приложение:
Параметры сообщений и их функции. (Взято с официального сайта):
WM_COMMAND Messages
Previous track button 40044
Next track button 40048
Play button 40045
Pause/Unpause button 40046
Stop button 40047
Fadeout and stop 40147
Stop after current track 40157
Fast-forward 5 seconds 40148
Fast-rewind 5 seconds 40144
Start of playlist 40154
Go to end of playlist 40158
Open file dialog 40029
Open URL dialog 40155
Open file info box 40188
Set time display mode to elapsed 40037
Set time display mode to remaining 40038
Toggle preferences screen 40012
Open visualization options 40190
Open visualization plug-in options 40191
Execute current visualization plug-in 40192
Toggle about box 40041
Toggle title Autoscrolling 40189
Toggle always on top 40019
Toggle Windowshade 40064
Toggle Playlist Windowshade 40266
Toggle doublesize mode 40165
Toggle EQ 40036
Toggle playlist editor 40040
Toggle main window visible 40258
Toggle minibrowser 40298
Toggle easymove 40186
Raise volume by 1% 40058
Lower volume by 1% 40059
Toggle repeat 40022
Toggle shuffle 40023
Open jump to time dialog 40193
Open jump to file dialog 40194
Open skin selector 40219
Configure current visualization plug-in 40221
Reload the current skin 40291
Close Winamp 40001
Moves back 10 tracks in playlist 40197
Show the edit bookmarks 40320
Adds current track as a bookmark 40321
Play audio CD 40323
Load a preset from EQ 40253
Save a preset to EQF 40254
Opens load presets dialog 40172
Opens auto-load presets dialog 40173
Load default preset 40174
Opens save preset dialog 40175
Opens auto-load save preset 40176
Opens delete preset dialog 40178
Opens delete an auto load preset dialog 40180
WM_USER Messages
0 Retrieves the version of Winamp running. Version will be 0x20yx for 2.yx. This is a good way to determine if you did in fact find the right window, etc.
100 Starts playback. A lot like hitting 'play' in Winamp, but not exactly the same
101 Clears Winamp's internal playlist.
102 Begins play of selected track.
103 Makes Winamp change to the directory C:\\download
104 Returns the status of playback. If 'ret' is 1, Winamp is playing. If 'ret' is 3, Winamp is paused. Otherwise, playback is stopped.
105 If data is 0, returns the position in milliseconds of playback. If data is 1, returns current track length in seconds. Returns -1 if not playing or if an error occurs.
106 Seeks within the current track. The offset is specified in 'data', in milliseconds.
120 Writes out the current playlist to Winampdir\winamp.m3u, and returns the current position in the playlist.
121 Sets the playlist position to the position specified in tracks in 'data'.
122 Sets the volume to 'data', which can be between 0 (silent) and 255 (maximum).
123 Sets the panning to 'data', which can be between 0 (all left) and 255 (all right).
124 Returns length of the current playlist, in tracks.
125 Returns the position in the current playlist, in tracks (requires Winamp 2.05+).
126 Retrieves info about the current playing track. Returns samplerate (i.e. 44100) if 'data' is set to 0, bitrate if 'data' is set to 1, and number of channels if 'data' is set to 2. (requires Winamp 2.05+)
127 Retrieves one element of equalizer data, based on what 'data' is set to. 0-9 The 10 bands of EQ data. Will return 0-63 (+20db - -20db) 10 The preamp value. Will return 0-63 (+20db - -20db) 11 Enabled. Will return zero if disabled, nonzero if enabled.
128 Autoload. Will return zero if disabled, nonzero if enabled. To set an element of equalizer data, simply query which item you wish to set using the message above (127), then call this message with data
129 Adds the specified file to the Winamp bookmark list
135 Restarts Winamp
200 Sets the current skin. 'data' points to a string that describes what skin to load, which can either be a directory or a .zip file. If no directory name is specified, the default Winamp skin directory is assumed.
201 Retrieves the current skin directory and/or name. 'ret' is a pointer to the Skin name (or NULL if error), and if 'data' is non-NULL, it must point to a string 260 bytes long, which will receive the pathname to where the skin bitmaps are stored (which can be either a skin directory, or a temporary directory when zipped skins are used) (Requires Winamp 2.04+).
202 Selects and executes a visualization plug-in. 'data' points to a string which defines which plug-in to execute. The string can be in the following formats: vis_whatever.dll Executes the default module in vis_whatever.dll in your plug-ins directory. vis_whatever.dll,1 executes the second module in vis_whatever.dll C:\path\vis_whatever.dll,1 executes the second module in vis_whatever.dll in another directory
211 Retrieves (and returns a pointer in 'ret') a string that contains the filename of a playlist entry (indexed by 'data'). Returns NULL if error, or if 'data' is out of range.
212 Retrieves (and returns a pointer in 'ret') a string that contains the title of a playlist entry (indexed by 'data'). Returns NULL if error, or if 'data' is out of range.
241 Opens an new URL in the minibrowser. If the URL is NULL it will open the Minibrowser window
242 Returns 1 if the internet connecton is available for Winamp
243 Asks Winamp to update the information about the current title
245 Sets the current playlist item
246 Retrives the current Minibrowser URL into the buffer.
247 Flushes the playlist cache buffer
248 Blocks the Minibrowser from updates if value is set to 1
249 Opens an new URL in the minibrowser (like 241) except that it will work even if 248 is set to 1
250 Returns the status of the shuffle option (1 if set)
251 Returns the status of the repeat option (1 if set)
252 Sets the status of the suffle option (1 to turn it on)
253 Sets the status of the repeat option (1 to turn it on)
Приятного Вам прослушивания музыки !!!
Взято с
Взято из
23.03.1999
01.03.1999
3D TT is a 3D game engine for a game like Transport Tycoon for Windows from Peter Dobrovka ( dobrovka@hkn.de ) and WAY-X (a group of hobby programmers).
Based on OpenGL
Multitextured landscape (without shading)
Perspective and isometric view
Large maps (1024x1024)
3D Sprites
Moving objects (esp. trains)
Integrated editor
Written in Delphi Pascal
More information, screenshots and a demo can be found on the (german) under 3DTT (click one of the four icons in the top frame to view screenshots etc).
14.01.1999
14.01.1999
Erik Unger manages a site for 3D API Bindings for Delphi:
Support for DirectX 6.0 for Delphi 2, 3 and 4 (Erik Unger )
Support for OpenGL 1.1 ( Mike Lischke )
Support for Glide 2.43 (Erik Unger and Eric Nowinski)
More information and the source can be found on the .
20.11.1998
01.04.1997
TGMP is a 3D graphics engine for PCs using DELPHI by Peter Dove (peterd@graphicalmagick.com) and Don Peer (dpeer@mgl.ca).
Shaded linear texture mapping.
Gouraud shading and wireframe rendering.
Z sorting.
16 bit color support for Windows 95.
Object Pascal / Delphi 2 source with good comments.
A longer text document describes the techniques used.
The source files can be found at the under the name DI9704DP.ZIP.
03.11.1997
07.10.1997
OGLCFD are Delphi 3.0 VCL components providing an object oriented interface to the OpenGL API for Windows 95 and Windows NT. The OGLCFD is distributed by SignSoft GmbH.
Simple API wrapper around OpenGL, the standard OpenGL calls are also awailable.
OpenGL view
Cameras
Camera controllers
Light sources
Materials
Textures
3D objects
More information, screenshots and a demo can be found on the or the
08.04.1997
08.04.1997
TGMP V2 is a commercial real-time rendering system for PCs written in Delphi 2.0 from Graphical Magick Productions Ltd, written by Peter Dove (peterd@graphicalmagick.com).
Shaded linear texture mapping.
Gouraud and flat shading, wireframe and point rendering.
Z-buffer rendering.
Uses DirectX 3 for rendering.
BMP and PPM texture file support.
Cylindrical and spherical texture wrapping.
Loads DirectX X format, convertor available for 3DS to X .
Written in Object Pascal / Delphi 2 (also the api).
More information and a demo can be found on the .
16.07.1996
16.07.1996
The CR3D is a 3D graphics engine for Delphi 2.0 from Romesh (prakash@earthlink.net).
Support for DirectDraw or WinG under Windows 95 / NT 4.0.
8 and 16-bit color mode.
Linear texture mapping.
Flat shading.
Z-buffer rendering.
3DS and PLG file reader.
More information and a beta version on the .
12.03.1998
01.01.1995
The MGL is a 3D graphics library for PCs from SciTech.
Flat and gouraud shading.
Support for DOS, Windows 3.1 / 95 / NT.
SVGA support.
BSP sorting and zbuffer rendering
2D and 3D functions.
3D modeling system.
Written in C++ and ASM.
Support for Borland C++, Watcom C++, Delphi, Visual C++.
Support for DirectDraw acceleration functions.
Support for OpenGL for Windows ( Microsoft, Silicon Graphics and Mesa ) API within the MGL framework.
Support for stereo LC shutter glasses (requires hardware stereo support)
More information and source can be found on the .
09.04.1999
15.08.1997
BSP is a doom level viewer for PCs from Ivailo Belchev (ivob@geocities.com ) .
Non orthogonal walls.
Floor and ceiling texture mapping.
Depthcueing.
C++ / ASM source.
The demo and source can be found on the .
Paul Toth has made two pascal versions of the BSP engine (for Delphi 2+ and BP7) that can be found on the .
02.05.1997
06.07.1995
The 4DX Rendering Engine is a commercial doom/heretic game engine from Jaimi McEntire (jaimimc@aol.com) from Eldermage Corp.
Animated sky mapping.
Non rectangular walls with different height.
Looking up/down is done via y-shearing (as in Heretic, Dark Forces etc).
Animated sprite objects.
Transparent textures.
Interactive level and texture editor.
2D effects like snow.
Sound support.
DOS and Windows libraries available.
4DX is a C++ Library and requires Watcom C++ v 10.0, 4DX is fully 32bit.
Doom WAD file importer.
Available as Delphi 2.0 VCL, as ActiveX control for Visual Basic, as Linkable Library for Visual C++ or as DLL.
Map editor.
More information and a demo can be found on the .
An older demo can be found on . More info in the .
All the 3D Engine.de pages are © by Cristian Yaming
Взято с
Автор: Александр Ермолаев
{
Программа вычисляет время восхода и захода
солнца по дате (с точностью до минуты) в пределах
нескольких текущих столетий. Производит корректировку, если
географическая
точка находится в арктическом или антарктическом регионе, где заход
или восход солнца
на текущую дату может не состояться. Вводимые данные: положительная
северная широта и
отрицательная западная долгота. Часовой пояс указывается относительно
Гринвича
(например, 5 для EST и 4 для EDT). Алгоритм обсуждался в
"Sky & Telescope" за август 1994, страница 84.
}
program sunproject;
uses
Forms,
main in 'main.pas' {Sun};
{$R *.RES}
begin
Application.Initialize;
Application.Title := 'Sun';
Application.CreateForm(TSun, Sun);
Application.Run;
end.
main.dfm
object Sun: TSun
Left = 210
Top = 106
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
Caption = 'Sun'
ClientHeight = 257
ClientWidth = 299
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
OnCreate = CreateForm
PixelsPerInch = 96
TextHeight = 13
object GroupBoxInput: TGroupBox
Left = 4
Top = 4
Width = 173
Height = 93
Caption = ' Ввод '
TabOrder = 0
object LabelLongitude: TLabel
Left = 35
Top = 44
Width = 78
Height = 13
Alignment = taRightJustify
Caption = 'Долгота (град):'
end
object LabelTimeZone: TLabel
Left = 13
Top = 68
Width = 100
Height = 13
Alignment = taRightJustify
Caption = 'Часовая зона (час):'
end
object LabelAtitude: TLabel
Left = 40
Top = 20
Width = 73
Height = 13
Alignment = taRightJustify
Caption = 'Широта (град):'
end
object EditB5: TEdit
Tag = 1
Left = 120
Top = 16
Width = 37
Height = 21
TabOrder = 0
Text = '0'
end
object EditL5: TEdit
Tag = 2
Left = 120
Top = 40
Width = 37
Height = 21
TabOrder = 1
Text = '0'
end
object EditH: TEdit
Tag = 3
Left = 120
Top = 64
Width = 37
Height = 21
TabOrder = 2
Text = '0'
end
end
object GroupBoxCalendar: TGroupBox
Left = 184
Top = 4
Width = 109
Height = 93
Caption = ' Календарь '
TabOrder = 1
object LabelD: TLabel
Left = 19
Top = 20
Width = 30
Height = 13
Alignment = taRightJustify
Caption = 'День:'
end
object LabelM: TLabel
Left = 13
Top = 44
Width = 36
Height = 13
Alignment = taRightJustify
Caption = 'Месяц:'
end
object LabelY: TLabel
Left = 28
Top = 68
Width = 21
Height = 13
Alignment = taRightJustify
Caption = 'Год:'
end
object EditD: TEdit
Tag = 1
Left = 56
Top = 16
Width = 37
Height = 21
TabOrder = 0
Text = '0'
end
object EditM: TEdit
Tag = 2
Left = 56
Top = 40
Width = 37
Height = 21
TabOrder = 1
Text = '0'
end
object EditY: TEdit
Tag = 3
Left = 56
Top = 64
Width = 37
Height = 21
TabOrder = 2
Text = '0'
end
end
object ButtonCalc: TButton
Left = 12
Top = 227
Width = 169
Height = 25
Caption = '&Вычислить'
TabOrder = 2
OnClick = ButtonCalcClick
end
object ListBox: TListBox
Left = 4
Top = 104
Width = 289
Height = 117
ItemHeight = 13
TabOrder = 3
end
object ButtonClear: TButton
Left = 192
Top = 227
Width = 91
Height = 25
Caption = '&Очистить'
TabOrder = 4
OnClick = ButtonClearClick
end
end
main.pas
unit main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,
StdCtrls;
type
TSun = class(TForm)
GroupBoxInput: TGroupBox;
LabelLongitude: TLabel;
EditB5: TEdit;
EditL5: TEdit;
LabelTimeZone: TLabel;
EditH: TEdit;
GroupBoxCalendar: TGroupBox;
LabelD: TLabel;
LabelM: TLabel;
LabelY: TLabel;
EditD: TEdit;
EditM: TEdit;
EditY: TEdit;
ButtonCalc: TButton;
ListBox: TListBox;
ButtonClear: TButton;
LabelAtitude: TLabel;
procedure Calendar; // Календарь
procedure GetTimeZone; // Получение часового пояса
procedure PosOfSun; // Получаем положение солнца
procedure OutInform; // Процедура вывода информации
procedure PossibleEvents(Hour: integer); // Возможные события на
полученный час
procedure GetDate; //Получить значения даты
procedure GetInput; //Получить значения широты,...
procedure ButtonCalcClick(Sender: TObject);
procedure CreateForm(Sender: TObject);
procedure ButtonClearClick(Sender: TObject);
private
function Sgn(Value: Double): integer; // Сигнум
public
{ Public declarations }
end;
var
Sun: TSun;
st: string;
aA, aD: array[1..2] of double;
B5: integer;
L5: double;
H: integer;
Z, Z0, Z1: double;
D: double;
M, Y: integer;
A5, D5, R5: double;
J3: integer;
T, T0, TT, T3: double;
L0, L2: double;
H0, H1, H2, H7, N7, D7: double;
H3, M3: integer;
M8, W8: double;
A, B, A0, D0, A2, D1, D2, DA, DD: double;
E, F, J, S, C, P, L, G, V, U, W: double;
V0, V1, V2: double;
C0: integer;
AZ: double;
const
P2 = Pi * 2; // 2 * Pi
DR = Pi / 180; // Радиан на градус
K1 = 15 * DR * 1.0027379;
implementation
{$R *.DFM}
function TSun.Sgn(Value: Double): integer;
begin
{if Value = 0 then} Result := 0;
if Value > 0 then
Result := 1;
if Value < 0 then
Result := -1;
end;
procedure TSun.Calendar;
begin
G := 1;
if Y < 1583 then
G := 0;
D1 := Trunc(D);
F := D - D1 - 0.5;
J := -Trunc(7 * (Trunc((M + 9) / 12) + Y) / 4);
if G = 1 then
begin
S := Sgn(M - 9);
A := Abs(M - 9);
J3 := Trunc(Y + S * Trunc(A / 7));
J3 := -Trunc((Trunc(J3 / 100) + 1) * 3 / 4);
end;
J := J + Trunc(275 * M / 9) + D1 + G * J3;
J := J + 1721027 + 2 * G + 367 * Y;
if F >= 0 then
Exit;
F := F + 1;
J := J - 1;
end;
procedure TSun.GetTimeZone;
begin
T0 := T / 36525;
S := 24110.5 + 8640184.813 * T0;
S := S + 86636.6 * Z0 + 86400 * L5;
S := S / 86400;
S := S - Trunc(S);
T0 := S * 360 * DR;
end;
procedure TSun.PosOfSun;
begin
// Фундаментальные константы
// (Van Flandern & Pulkkinen, 1979)
L := 0.779072 + 0.00273790931 * T;
G := 0.993126 + 0.0027377785 * T;
L := L - Trunc(L);
G := G - Trunc(G);
L := L * P2;
G := G * P2;
V := 0.39785 * Sin(L);
V := V - 0.01000 * Sin(L - G);
V := V + 0.00333 * Sin(L + G);
V := V - 0.00021 * TT * Sin(L);
U := 1 - 0.03349 * Cos(G);
U := U - 0.00014 * Cos(2 * L);
U := U + 0.00008 * Cos(L);
W := -0.00010 - 0.04129 * Sin(2 * L);
W := W + 0.03211 * Sin(G);
W := W + 0.00104 * Sin(2 * L - G);
W := W - 0.00035 * Sin(2 * L + G);
W := W - 0.00008 * TT * Sin(G);
// Вычисление солнечных координат
S := W / Sqrt(U - V * V);
A5 := L + ArcTan(S / Sqrt(1 - S * S));
S := V / Sqrt(U);
D5 := ArcTan(S / Sqrt(1 - S * S));
R5 := 1.00021 * Sqrt(U);
end;
procedure TSun.PossibleEvents(Hour: integer);
var
num: string;
begin
st := '';
L0 := T0 + Hour * K1;
L2 := L0 + K1;
H0 := L0 - A0;
H2 := L2 - A2;
H1 := (H2 + H0) / 2; // Часовой угол,
D1 := (D2 + D0) / 2; // наклон в получасе
if Hour <= 0 then
V0 := S * Sin(D0) + C * Cos(D0) * Cos(H0) - Z;
V2 := S * Sin(D2) + C * Cos(D2) * Cos(H2) - Z;
if Sgn(V0) = Sgn(V2) then
Exit;
V1 := S * Sin(D1) + C * Cos(D1) * Cos(H1) - Z;
A := 2 * V2 - 4 * V1 + 2 * V0;
B := 4 * V1 - 3 * V0 - V2;
D := B * B - 4 * A * V0;
if D < 0 then
Exit;
D := Sqrt(D);
if (V0 < 0) and (V2 > 0) then
st := st + 'Восход солнца в ';
if (V0 < 0) and (V2 > 0) then
M8 := 1;
if (V0 > 0) and (V2 < 0) then
st := st + 'Заход солнца в ';
if (V0 > 0) and (V2 < 0) then
W8 := 1;
E := (-B + D) / (2 * A);
if (E > 1) or (E < 0) then
E := (-B - D) / (2 * A);
T3 := Hour + E + 1 / 120; // Округление
H3 := Trunc(T3);
M3 := Trunc((T3 - H3) * 60);
Str(H3: 2, num);
st := st + num + ':';
Str(M3: 2, num);
st := st + num;
H7 := H0 + E * (H2 - H0);
N7 := -Cos(D1) * Sin(H7);
D7 := C * Sin(D1) - S * Cos(D1) * COS(H7);
AZ := ArcTan(N7 / D7) / DR;
if (D7 < 0) then
AZ := AZ + 180;
if (AZ < 0) then
AZ := AZ + 360;
if (AZ > 360) then
AZ := AZ - 360;
Str(AZ: 4: 1, num);
st := st + ', азимут ' + num;
end;
procedure TSun.OutInform;
begin
if (M8 = 0) and (W8 = 0) then
begin
if V2 < 0 then
ListBox.Items.Add('Солнце заходит весь день ');
if V2 > 0 then
ListBox.Items.Add('Солнце восходит весь день ');
end
else
begin
if M8 = 0 then
ListBox.Items.Add('В этот день солнце не восходит ');
if W8 = 0 then
ListBox.Items.Add('В этот день солнце не заходит ');
end;
end;
procedure TSun.GetDate;
begin
D := StrToInt(EditD.text);
M := StrToInt(EditM.text);
Y := StrToInt(EditY.text);
end;
procedure TSun.GetInput;
begin
B5 := StrToInt(EditB5.Text);
L5 := StrToInt(EditL5.Text);
H := StrToInt(EditH.Text);
end;
procedure TSun.ButtonCalcClick(Sender: TObject);
var
C0: integer;
begin
GetDate;
GetInput;
ListBox.Items.Add('Широта: ' + EditB5.Text +
' Долгота: ' + EditL5.Text +
' Зона: ' + EditH.Text +
' Дата: ' + EditD.Text +
'/' + EditM.Text +
'/' + EditY.Text);
L5 := L5 / 360;
Z0 := H / 24;
Calendar;
T := (J - 2451545) + F;
TT := T / 36525 + 1; // TT - столетия, начиная с 1900.0
GetTimeZone; // Получение часового пояса
T := T + Z0;
PosOfSun; // Получаем положение солнца
aA[1] := A5;
aD[1] := D5;
T := T + 1;
PosOfSun;
aA[2] := A5;
aD[2] := D5;
if aA[2] < aA[1] then
aA[2] := aA[2] + P2;
Z1 := DR * 90.833; // Вычисление зенита
S := Sin(B5 * DR);
C := Cos(B5 * DR);
Z := Cos(Z1);
M8 := 0;
W8 := 0;
A0 := aA[1];
D0 := aD[1];
DA := aA[2] - aA[1];
DD := aD[2] - aD[1];
for C0 := 0 to 23 do
begin
P := (C0 + 1) / 24;
A2 := aA[1] + P * DA;
D2 := aD[1] + P * DD;
PossibleEvents(C0);
if st <> '' then
ListBox.Items.Add(st);
A0 := A2;
D0 := D2;
V0 := V2;
end;
OutInform;
ListBox.Items.Add(''); // Разделяем данные
end;
procedure TSun.CreateForm(Sender: TObject);
begin
EditD.Text := FormatDateTime('d', Date);
EditM.Text := FormatDateTime('m', Date);
EditY.Text := FormatDateTime('yyyy', Date);
end;
procedure TSun.ButtonClearClick(Sender: TObject);
begin
ListBox.Clear;
end;
end.
Взято с
Взлом Windows-приложений
Взлом Windows-приложений
Введение
Для начала я научу вас пользоваться W32Dasm. Я не хочу вам давать детальную помощь, как делать краки, но я могу научить вас самим добывать себе умения и навыки взлома. Когда вы используете W32Dasm, знайте, что он не даст вам серийные номера или коды, он лишь покажет путь, где находится место, где можно эти номера вводить. То, что я делаю каждый день при взломе программ, будет описано в этом справочнике, шаг за шагом.
Инструменты
Из инструментов взлома вам нужно следующее:
W32Dasm 8.5 или боолее позднюю версию,
Hacker's View 5.24,
Norton Commander (я позднее объясню, почему я его использую).
Turbo Pascal 7.0
TASM и TLINK 3.0
Как кракнуть Quick View Plus 4.0
Запустите ORDER32.EXE
Кликните на $49 Single User License (вы можете кликнуть и на $59), затем ACCEPT, потом UNLOCK BY PHONE.
Введите любой код для получения сообщения об ошибке (вы должны записать это сообщение), потом выйдите из программы, кликнув на CANCEL.
Запустите Norton Comander, перейдите в директорию QVP.
Скопируйте ORDER32.EXE в ORDER32.EXX (для сохранности), а затем скопируйте ORDER32.EXE в 1.EXE (для использования в W32Dasm).
Запустите W32Dasm и раздессимблируйте 1.EXE.
После этого, кликните на STRING DATA REFERENCE, найдите там сообщение "You have entered an incorrect code.Please check your entry" (вы должны помнить,что это было сообщение об ошибке) и дважды щелкните мышью по нему.
Закройте SDR окно. Вы должны увидеть сообщение:
* Possible reference to String Resource ID=00041: "You have entered...
:004049F8 6A29 push 00000029
:004049FA FF353CCE4000 push dword ptr [0040CE3C]
ОК, теперь вы должны найти последнее сравнение типа CMP,JNE, JE,TEST и т.д. перед сообщением об ошибке. Нажимайте стрелку "вверх", пока не найдете:
:004049CD 755A jne 00404A29
* Possible reference to String Resource ID=00032: "You must select...
:004049CF 6A20 push 00000020
...
...
* Possible reference to String Resource ID=00040: "Unlock Error"
Теперь вы знаете, куда идет скачок при введении неправильного кода. Теперь можно посмотреть, что произойдет, если "jne" на "je". Убедитесь, что зеленая полоска находится на надписи:
004049CD 755A jne 00404A29, вы должны увидеть Offset address внизу на статусной строке типа @Offset 00003DCDh Это место, где вы можете внести изменения в ORDER32.EXE.
Перейдите обратно в Norton Commander, запустите HIEW ORDER32.EXE, нажмите F4 для выбора режима декодирования (Decode Mode), нажмите F5 и введите 3DCD. Вы должны увидеть следующее :
00003DCD:755A jne 000003E29
00003DCF: 6A20 push 020
00003DD1: FF15 call w,[di]
Это то место, где вы можете изменить байты, нажмите F3, введите 74, нажмите F9 для обновления ORDER32.EXE. Выйдите из HIEW.
Запустите ORDER32.EXE, введите любой код. Ура ! Мы сломали QVP 4.0 ! Но ! Что будет, если ввести настоящий серийный номер ? Появляется сообщение об ошибке ! Что это ?
Снова запустиите HIEW ORDER32.EXE, нажмите F4, выберите Decode, нажмите F5 и введите 3DCD. Нажмите F3, введите EB, нажмите F9. Вы прямо "прыгнете" на Unlocked диалог.
Как кракнуть Hex WorkShop 2.51
Запустите HWORKS32.EXE
Кликните на HELP, About HEX Wo..
Введите любой код, чтобы получить сообщение об ошибке (вы должны записать это сообщение) и выйдите из программы.
Запустите Norton Commander, перейдите в директорию HWS.
Скопируйте файл HWORKS32.EXE в HWORKS32.EXX (для сохранности) и скопируйте файл HWORKS32.EXE в 1.EXE (для использования в W32Dasm).
Запустите W32Dasm и "разберите" 1.EXE.
После этого, нажмите мышью на FIND TEXT, введите "You have entered an" (вы должны помнить, что это сообщение об ошибочно введенном серийном номере) и найдите соответствующую строку (вы не сможете сделать это в SDR-окне !)
Вы должны увидеть следующую строку:
Name: DialogID_0075, # of Controls=003, Caption: "Registration Unsucce..
001-ControlID:FFFF, Control Class:""Control Text:"You have entered an..
002-ControlID:FFFF, Control Class:""Control Text:"Please confirm you..
Оk, теперь вы знаете, что ControlID будет использоваться, когда вы введете неверный код. Кликните FIND TEXT, введите "dialogid_0075" и вы найдете:
* Possible reference to DialogID_0075
:0041E233 6A75 push 00000075
:0041E235 8D8D10FFFFFF lea ecx, dword ptr [ebp+FF10]
Теперь вы должны поискать последнюю ссылку, типа CMP, JNE, JE и пр. перед диалогом об ошибке. Нажимайте клавишу "вверх", пока не найдете :
:0041E145 837DEC00 cmp dword ptr [ebp-14], 00000000
:0041E149 0F8479000000 je 0041E1C8
:0041E14F 8B8DFCFEFFFF mov ecx, dword ptr [ebp+FEFC]
Теперь вам нужно посмотреть, что произойдет, если "je" заменить на "jne". Убедитесь, что зеленая полоска установлена на строке
:0041E149 0F8479000000 je 0041E1C8.
Вы должны на нижней статусной строке увидеть оффсетный адрес, типа:
@Offset0001D549h.
Это то место, где вы сможете кракнуть HWORKS32.EXE
Перейдите обратно в Norton Commander, запустите HIEW HWORKS32.EXE, нажмите F4 для выбора режима декодирования (Decode Mode), нажмите F5 и введите ID549. Вы должны увидеть следующее :
0001D549: 0F847900 je 00001D5C6 ---------- (1)
0001D54D: 0000 add [bx][si],al
0001D54F: 8B8DFCFE mov cx,[di][0FEFC]
Это то место, где вы сможете изменить несколько байтов, нажмите F3, введите 0F85, нажмите F9 для обновления файла HWORKS32.EXE. Выйдите из HIEW.
Запустите HWORKS32.EXE и введите любой код, работает ? НЕТ !?!??!?! Хе-хе-хе... Не волнуйтесь ! Снова перейдите в Нортон. Скопируйте HWORKS32.EXX в HWORKS32.EXE (теперь вы видите, почему я делаю копию файла с расширением ЕХХ для сохранности). Теперь перейдите в W32Dasm, вы должны перейти туда, где только что были (на 0041У145).
Нажмите F3 для очередного поиска "DialogID_0075", вы должны найти:
* Possible reference to DialogID_0075
:00430ADD 6A75 push 00000075
:00430ADF 8D8D10FFFFFF lea ecx, dword ptr [ebp+FF10]
Ok, теперь вы теперь можете посмотреть на последние ссылки, типа CMP, JNE, JE и т.д. перед диалогом об ошибке. Нажимайте стрелку вверх, пока не найдете :
:004309EF 837DEC00 cmp dword ptr [ebp-14], 00000000
:004309F3 0F8479000000 je 00430A72
:004309F9 8B8DFCFEFFFF mov ecx, dword ptr [ebp+FEFC]
Теперь вы можете посмотреть, что произойдет, если "je" заменить на 'jne". (это должно сработать). Переместите полоску на:
004309F3 0F8479000000 je 00430A72.
На статусной строке внизу экрана вы должны следующее:
@Offset0002FDF3h (оффсетный адрес).
Это то место, где вы сможете кракнуть HWORKS32.EXE.
Перейдите в Norton Commander, запустите HIEW HWORKS32.EXE, нажмите F4 для выбора Decode Mode (ASM), нажмите F5 и введите 2FDF3. Вы должны увидеть:
0002FDF3: 0F847900 je 00001D5C6 ---------- (1)
0002FDF7: 0000 add [bx][si],al
0002FDF9: 8B8DFCFE mov cx,[di][0FEFC]
Это то место, где вы сможете изменить несколько байтов, нажмите F3, введите 0F85, нажмите F9 для обновления файла HWORKS32.EXE. Выйдите из HIEW.
Запустите снова HWORKS32.EXE и введите любой код. Работает ? Виола !!! Поздравляю !!! Вы крякнули HEX WorkShop 2.51 !
Как сделать собственный патч
Здесь напечатан исходный код на Паскале :
uses Crt;
const
A: array[1..1] of record {<-------- 1 byte to be patched}
A: Longint;
B: Byte;
end =
((A: $3DCD; B: $EB));
{<--------------- offset "3DCD" and byte "EB" to be changed}
var
Ch: Char;
I: Byte;
F: file;
FN: file of byte;
Size: longint;
begin
Writeln('TKC Little Patch');
writeln('Crack for QVP 4.0 by TKC/PC 97');
Assign(F, 'ORDER32.EXE'); {<-------------- filename to be patched}
{$I-}Reset(F, 1);
{$I+}
if IOResult <> 0 then
begin
writeln('File not found!');
halt(1);
end;
for I := 1 to 1 do {<---------------------- 1 byte to be patched}
begin
Seek(F, A[I].A);
Ch := Char(A[I].B);
Blockwrite(F, Ch, 1);
end;
Writeln('File successfully patched!');
end.
Исходник на ассемблере (для изучающих ассемблер):
DOSSEG
.MODEL SMALL
.STACK 500h
.DATA
.CODE
PatchL EQU 6
Buffer Db PatchL Dup(1)
handle dw ?
intro db "TKC's Little Patch",0dh,0ah,"Crack for QVP 4.0 by TKC/PC '97$"
FileName db "ORDER32.EXE",0 ;<------- filename to be patched
notfound db 0dh,0ah,"File not found!$"
cracked db 0dh,0ah,"File successfully patched. Enjoy!$"
Cant db 0dh,0ah,"Can't write to file.$"
Done db "File has been made.$"
String db 0EBh,0 ;<------------- byte "EB" to be patched
START:
mov ax,cs
mov ds,ax
mov dx,offset intro ;point to the time prompt
mov ah,9 ;DOS: print string
int 21h
jmp openfile
openfile:
mov ax,cs
mov ds,ax
mov ax,3d02h
mov dx,offset FileName
int 21h
mov handle,ax
cmp ax,02h
je filedontexist
jmp write
filedontexist:
mov ax,cs
mov ds,ax
mov dx,offset notfound
mov ah,9 ;DOS: print string
int 21h ;display the time prompt
jmp exit
Write:
mov bx,handle
mov cx,0000h
mov dx,3DCDh ;<------------- offset "3DCD"
mov ax,4200h
int 21h
mov cx,patchl
mov dx,offset String
mov ah,40h
mov cx,01h
int 21h
mov ax,cs
mov ds,ax
mov dx,offset cracked
mov ah,9 ;DOS: print string
int 21h ;display the time prompt
jmp Exit
Exit:
mov ah,3eh
int 21h
mov ax,4c00h
int 21h
END START
Заключительные слова
Здесь несколько важных функций, используемых для крэкинга :
Hex: Asm: Means
75 or 0F85 jne jump if not equal
74 or 0F84 je jump if equal
EB jmp jump directly to
90 nop no operation
77 or 0F87 ja jump if above
0F86 jna jump if not above
0F83 jae jump if above or equal
0F82 jnae jump if not above or equal
0F82 jb jump if below
0F83 jnb jump if not below
0F86 jbe jump if below or equal
0F87 jnbe jump if not below or equal
0F8F jg jump if greater
0F8E jng jump if not greater
0F8D jge jump if greater or equal
0F8C jnge jump if not greater or equal
0F8C jl jump if less
0F8D jnl jump if not less
0F8E jle jump if less or equal
0F8F jnle jump if not less or equal
Ваши небольшие знания по Ассемберу, вам, естественно, помогут, и они вам потребуются для использования Soft-ICE. Кроме того, вы сможете кракать эти куски с помощью W32Dasm как маньяк :-) Вы не сможете дизассемблировать программы на Visual Basic, для него вам понадобятся специальные декомпилеры, но с помощью SoftIce'a поломать их можно и без декомпилятора.
Удачи !
Взято с
WEB страничка внутри Delphi приложения
WEB страничка внутри Delphi приложения
WEB страничка внутри Delphi приложения
(Перевод одноимённой статьи с сайта delphi.about.com )
Многие из Вас спрашивают, как сделать, чтобы приложением могло содержать в себе различные компоненты в стиле Web, включая HTML ресурсы и картинки, которые являются частью Вашего проекта. Статья показывает, как можно легко добавить в Delphi приложение HTML и связанные с ним файлы (картинки).
Создание HTML страницы
Для начала мы должны создать простую страницу HTML. Для этого можно использовать Ваш любимый HTML редактор, и создать одну страницу с одним изображением. К примеру, назовём этот файл aboutindex.htm. Обратите внимание, что, когда Вы добавляете тэг картинки внутрь htm страницы, то в исходнике страницы будет присутствовать следудующая строка:
<img src="../graphics/adp.gif" ...>
Нам необходимо подправить тэг IMG так, чтобы атрибут SRC равнялся имени, которое мы указали в ресурсах:
<img src="ABOUTDP" ...>
У меня HTML код выглядит следующим образом:
<HTML><HEAD><TITLE>HTML inside a Delphi exe</TITLE></HEAD><BODY>
This is a HTML Delphi resource test:<br>
<img src="ABOUTDP" width=106 height=58 border=0 alt="">
</BODY></HTML>
Создание и компиляция файла ресурсов
Запомните, что для того, чтобы создать новый скрипт-файл ресурсов, необходимо:
1. Создать новый текстовый файл в директории Вашего проекта.
2. Переименовать его в AHTMLDelphi.rc.
3. Добавить следующие две строки текста в файл AHTMLDelphi.rc.
DELPHIINDEX HTML "c:\Delphi\projects\aboutindex.htm"
ABOUTDP GIF "c:\library\graphics\adp.gif"
Обратите внимание, что "HTML" тип ресурса RT_HTML, определён как "23". Это значение является дефолтовым для протокола RES.
Таким образом мы подготовили одну HTML страницу и одну картинку GIF, которые будут включены в исполняемый EXE модуль.
Следующий шаг - это компиляция .rc файла. Для компиляции файла AHTMLDelphi.rc в файл .res, выполните следующую команду из командной строки (в директории Вашего проекта):
BRCC32 AHTMLDelphi.RC
Заключительный шаг - это добавление следующей директивы компилятора в unit Вашего проекта. Следующая строка заставляет компилятор включить в проект файл RES:
{$R AHTMLDelphi.RES}
Отображение внутри Web браузера
После того, как Вы получите экзешник приложения (назовём его, например, myhtmldelphi.exe), то HTML ресурсы, содержащиеся в нём, могут быть доступны через протокол RES: . Запустите Internet Explorer и, адресной строке напишите следующее:
res://c:\myhtmldelphi.exe/DELPHIINDEX
Взято с Исходников.ru
What is the message Generating font matrix when starting Kylix?
What is the message Generating font matrix when starting Kylix?
Why am I getting a message that says "Generating font matrix. Please wait" when I start Kylix?
This should only happen the first time you start Kylix using the startkyix script. The font matrix is used by the Wine implementation of the Win32 API and you should wait until it finishes. There have been reports of this appearing to take forever in some Linux versions. If it seems to take too long you can try canceling it and Kylix should still run okay.
Where are my components?
Where are my components?
Windows NT and 2000:
Most likely Delphi was installed by an administrator or a user with administrator rights and the user currently logged on does not have administrator rights. The component library is failing to load because it does not have the registry keys available that indicate where the packages are located. Install first as Admin, then do a 'Registry Settings Only' install for each user to get all the necessary DLL's and registry key entries to run Delphi under a specific user profile.
To do this login as the user and run the Delphi install. Around 3 screens in you'll get to the screen where you need to choose the install directories. At the bottom of this screen is a check box to select for Registry Settings Only. Complete the install as usual. It should be much faster since no files are copied.
If it looks like the components are there but the bitmap images are missing then try unistalling and reinstalling each package. This can be done very easily by going into the Delphi menu option Component | Install Packages. Uncheck each of the packages and then check it again. Say "Yes" to any message boxes that appear asking about the removal of related packages. I recommend you start by removing "Borland Database Components" since this will remove several others as well.
Why can't I connect to an Access database using the BDE and native MSACCESS driver?
Why can't I connect to an Access database using the BDE and native MSACCESS driver?
Why can't I connect to an Access database using the BDE and native MSACCESS driver?
Access 2000/XP:
You cannot connect to an Access 2000 database using the BDE's native MSACCESS driver. It is recommended that you use ADO. You could also connect using the BDE with ODBC.
Access 95 or 97:
You may get the message "BDE error 13059" and "General SQL error". If you are trying to connect to Access 95 or 97 databases using the BDE's native MSACCESS driver, then you need to have DAO 3.0 installed for Access 95 or DAO 3.5 for Access 97 (DAO = Data Access Objects for Visual Basic). You can install the DAO by doing a custom installation of MS Office and selecting only to install Data Access Objects for Visual Basic. You must also have the correct DLL32 setting in the BDE Administrator for the DAO you have installed: IDDA3532.DLL for Access 97, IDDAO32.DLL for Access 95.
Why can't I run my Kylix application outside of the IDE?
Why can't I run my Kylix application outside of the IDE?
What do I need to do to run a Kylix application outside of the IDE?
You need to have your LD_LIBRARY_PATH variable set to your bin directory. Your bin directory is located under your Kylix directory. You can set this by sourcing the kylixpath script. From an xterm window go to the Kylix bin directory and enter
source kylixpath
See the README file for more details.
Win1251 <-> Koi8r
Win1251 <-> Koi8r
typeTConvertChars = array[#128..#255] of char;
const Win_KoiChars: TConvertChars = (#128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#060,#139,#140,#141,#142,#143,#144,#145,#146,#147,#148,#169,#150,#151,#152,#153,#154,#062,#176,#157,#183,#159,#160,#246,#247,#074,#164,#231,#166,#167,#179,#169,#180,#060,#172,#173,#174,#183,#156,#177,#073,#105,#199,#181,#182,#158,#163,#191,#164,#062,#106,#189,#190,#167,#225,#226,#247,#231,#228,#229,#246,#250,#233,#234,#235,#236,#237,#238,#239,#240,#242,#243,#244,#245,#230,#232,#227,#254,#251,#253,#154,#249,#248,#252,#224,#241,#193,#194,#215,#199,#196,#197,#214,#218,#201,#202,#203,#204,#205,#206,#207,#208,#210,#211,#212,#213,#198,#200,#195,#222,#219,#221,#223,#217,#216,#220,#192,#209);
Koi_WinChars: TConvertChars = (#128,#129,#130,#131,#132,#133,#134,#135,#136,#137,#138,#139,#140,#141,#142,#143,#144,#145,#146,#147,#148,#149,#150,#151,#152,#153,#218,#155,#17
6,#157,#183,#159,#160,#161,#162,#184,#186,#165,#166,#191,#168,#169,#170,#171,#172,#173,#174,#175,#156,#177,#178,#168,#170,#181,#182,#175,#184,#185,#186,#187,#188,#189,#190,#185,#254,#224,#225,#246,#228,#229,#244,#227,#245,#232,#233,#234,#235,#236,#237,#238,#239,#255,#240,#241,#242,#243,#230,#226,#252,#251,#231,#248,#253,#249,#247,#250,#222,#192,#193,#214,#196,#197,#212,#195,#213,#200,#201,#202,#203,#204,#205,#206,#207,#223,#208,#209,#210,#211,#198,#194,#220,#219,#199,#216,#221,#217,#215,#218);
function Win_KoiConvert(const St: string): string;
var i: integer;
begin
Result:=St;
for i:=1 to Length(St) do
if St[i]>#127 then Result[i]:=Win_KoiChars[St[i]];
end;
Автор:
SongВзято из
Windows
Windows
Cодержание раздела:
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
·
См. также другие разделы:
WMF ---> BMP
WMF ---> BMP
procedure ConvertWMF2BMP
(const WMFFileName, BMPFileName: TFileName);
var
MetaFile : TMetafile;
Bitmap : TBitmap;
begin
Metafile := TMetaFile.Create;
Bitmap := TBitmap.Create;
try
MetaFile.LoadFromFile(WMFFileName);
with Bitmap do
begin
Height := Metafile.Height;
Width := Metafile.Width;
Canvas.Draw(0, 0, MetaFile);
SaveToFile(BMPFileName);
end;
finally
Bitmap.Free;
MetaFile.Free;
end;
end;
Использование:
ConvertWMF2BMP('c:\mypic.wmf','c:\mypic.bmp')
Взято с Исходников.ru
XML
XML
Cодержание раздела:
См. также статьи в других разделах:
Загрузка 256-цветного TBitmap
Загрузка 256-цветного TBitmap
Автор: Steve Schafer
Windows не очень полезен, когда мы имеем дело с 256-цветными изображениями. Что делаю я (поскольку думаю, что это самый простой метод): я создаю в памяти изображение таким образом, чтобы TBitmap.LoadFromStream мог "принять" его. Данным методом я загружаю "сырой" ресурс изображения и размещаю его, используя инфорационный заголовок файла изображения. Вот потомок TBitmap, инкапсулирующий вышесказанное:
type
TMyBitmap = class(TBitmap)
public
procedure Load256ColorBitmap(Instance: THandle; BitmapName: PChar);
end;
procedure TMyBitmap.Load256ColorBitmap(Instance: THandle;
BitmapName: PChar);
var
HDib: THandle;
Size: LongInt;
Info: PBitmapInfo;
FileHeader: TBitmapFileHeader;
S: TMemoryStream;
begin
HDib := LoadResource(Instance, FindResource(Instance, BitmapName,
RT_BITMAP));
if HDib <> 0 then
begin
Info := LockResource(HDib);
Size := GetSelectorLimit(Seg(Info^)) + SizeOf(TBitmapFileHeader);
with FileHeader do
begin
bfType := $4D42;
bfSize := Size;
bfReserved1 := 0;
bfReserved2 := 0;
bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader);
case Info^.bmiHeader.biBitCount of
1: bfOffBits := bfOffBits + 2 * 4;
4: bfOffBits := bfOffBits + 16 * 4;
8: bfOffBits := bfOffBits + 256 * 4;
end;
end;
S := TMemoryStream.Create;
try
S.SetSize(Size);
S.Write(FileHeader, SizeOf(TBitmapFileHeader));
S.Write(Info^, Size - SizeOf(TBitmapFileHeader));
S.Position := 0;
LoadFromStream(S);
finally
S.Free;
FreeResource(HDib);
end;
end
else
raise EResNotFound.Create(Format('Не могу найти ресурс изображения %s',
[BitmapName]));
end;
Вот как можно это использовать:
Image1.Picture.Bitmap := TMyBitmap.Create;
TMyBitmap(Image1.Picture.Bitmap).Load256ColorBitmap(hInstance, 'BITMAP_1');
Взято из
Загрузка Bitmap из .res без потери палитры
Загрузка Bitmap из .res без потери палитры
procedureloadgraphic(naam:string);
var
HResInfo: THandle;
BMF: TBitmapFileHeader;
MemHandle: THandle;
Stream: TMemoryStream;
ResPtr: PByte;
ResSize: Longint;
null:array [0..8] of char;
begin
strpcopy (null, naam);
HResInfo := FindResource(HInstance, null, RT_Bitmap);
ResSize := SizeofResource(HInstance, HResInfo);
MemHandle := LoadResource(HInstance, HResInfo);
ResPtr := LockResource(MemHandle);
Stream := TMemoryStream.Create;
try
Stream.SetSize(ResSize + SizeOf(BMF));
BMF.bfType := $4D42;
Stream.write(BMF, SizeOf(BMF));
Stream.write(ResPtr^, ResSize);
Stream.Seek(0, 0);
Bitmap:=tbitmap.create;
Bitmap.LoadFromStream(Stream);
finally
Stream.Free;
end;
FreeResource(MemHandle);
end;
Взято из
Загрузка DLL
Загрузка DLL
Предлагаю вашему вниманию очередной выпуск рассылки, в котором я продолжаю обсуждать
вопросы разработки и использования DLL в Borland Delphi. Для новых подписчиков сообщаю,
что первую часть статьи они могут посмотреть в архиве рассылки, выпуск номер 13.
Прошу прощения у тех, кто писал мне, но не получил ответа. В ближайшее время постараюсь это исправить.
Итак, продолжим.
Загрузка DLL
Прежде чем начать использование какой-либо процедуры или функции, находящейся в динамической библиотеке,
вам необходимо загрузить DLL в оперативную память. Загрузка библиотеки может быть осуществлена
одним из двух способов: статическая загрузка и динамическая загрузка.
Оба метода имеют как преимущества, так и недостатки.
Статическая загрузка означает, что динамическая библиотека загружается автоматически
при запуске на выполнение использующего ее приложения. Для того чтобы использовать такой способ загрузки,
вам необходимо воспользоваться ключевым словом external при описании экспортируемой из
динамической библиотеки функции или процедуры. DLL автоматически загружается при старте программы,
и Вы сможете использовать любые экспортируемые из нее подпрограммы точно так же,
как если бы они были описаны внутри модулей приложения.
Это наиболее легкий способ использования кода, помещенного в DLL .
Недостаток метода заключается в том, что если файл библиотеки, на который
имеется ссылка в приложении, отсутствует, программа откажется загружаться.
Смысл динамического метода заключается в том, что вы загружаете библиотеку не при старте приложения,
а в тот момент, когда вам это действительно необходимо. Сами посудите, ведь если функция, описанная
в динамической библиотеке, используется только при 10% запусков программы, то совершенно нет
смысла использовать статический метод загрузки. Выгрузка библиотеки из памяти в данном случае
также осуществляется под вашим контролем. Еще одно преимущества такого способа
загрузки DLL - это уменьшение (по понятным причинам) времени старта вашего приложения.
А какие же у этого способа имеются недостатки? Основной, как мне кажется, - это то, что использование
данного метода является более хлопотным, чем рассмотренная выше статическая загрузка.
Сначала вам необходимо воспользоваться функцией Windows API LoadLibrary .
Для получения указателя на экспортируемой процедуры или функции должна
использоваться функция GetProcAddress. После завершения использования библиотеки DLL
должна быть выгружена с применением FreeLibrary.
Вызов процедур и функций, загруженных из DLL.
Способ вызова процедур и функций зависит от того, каким образом вы загрузили динамическую библиотеку,
в которой эти подпрограммы находятся.
Вызов функций и процедур из статически загруженных DLL достаточно прост. Первоначально в приложении
должно содержаться описание экспортируемой функции (процедуры). После этого вы можете их использовать
точно так же, как если бы они были описаны в одном из модулей вашего приложения.
Для импорта функции или процедуры, содержащейся в DLL , необходимо использовать
модификатор external в их объявлении. К примеру, для рассмотренной нами выше процедуры HelloWorld
в вызывающем приложении должна быть помещена следующая строка:
procedure SayHello(AForm : TForm); external myfirstdll.dll';
Ключевое слово external сообщает компилятору, что данная процедура может быть найдена в
динамической библиотеке (в нашем случае - myfirstdll.dll).
Далее вызов этой процедуры выглядит следующим образом:
...
HelloWorld(self);
...
При импорте функции и процедур будьте особенно внимательны при написании их имен и интерфейсов!
Дело в том, что в процессе компиляции приложения не производится проверки на правильность имен объектов,
экспортируемых из DLL, осуществляться не будет, и если вы неправильно описали какую-нибудь функцию,
то исключение будет сгенерировано только на этапе выполнения приложения.
Импорт из DLL может проводиться по имени процедуры (функции), порядковому номеру или
с присвоением другого имени.
В первом случае вы просто объявляете имя процедуры и библиотеку, из которой ее импортируете
(мы это рассмотрели чуть выше). Импорт по порядковому номеру требует от вас указание этого самого номера:
procedure HelloWorld(AForm : TForm);
external myfirstdll.dll' index 15;
В этом случае имя, которое вы даете процедуре при импорте не обязательно должно совпадать с тем,
которое было указано для нее в самой DLL. Т.е. приведенная выше запись означает,
что вы импортируете из динамической библиотеки myfirstdll.dll процедуру, которая в ней экспортировалась
пятнадцатой, и при этом в рамках вашего приложения этой процедуре дается имя SayHello.
Если вы по каким-то причинам не применяете описанный выше способ импорта,
но тем не менее хотите изменить имя импортируемой функции (процедуры), то можно воспользоваться третьим методом:
procedure CoolProcedure;
external myfirstdll.dll' name DoSomethingReallyCool';
Здесь импортируемой процедуре CoolProcedure дается имя DoSomethingReallyCool.
Вызов процедур и функций, импортируемых из динамически загружаемых библиотек
несколько более сложен, чем рассмотренный нами выше способ. В данном случае требуется объявить
указатель на функцию или процедуру, которую вы собираетесь использовать.
Помните процедуру HelloWorld? Давайте посмотрим, что необходимо сделать для того,
чтобы вызвать ее на выполнение в случае динамической загрузки DLL. Во-первых, вам
необходимо объявить тип, который описывал бы эту процедуру:
type
THelloWorld = procedure(AForm : TForm);
Теперь вы должны загрузить динамическую библиотеку, с помощью GetProcAddress получить
указатель на процедуру, вызвать эту процедуру на выполнение, и, наконец, выгрузить DLL из памяти.
Ниже приведен код, демонстрирующий, как это можно сделать:
var
DLLInstance : THandle;
HelloWorld : THelloWorld;
begin
{ загружаем DLL }
DLLInstance := LoadLibrary(myfirstdll.dll');
{ получаем указатель }
@HelloWorld := GetProcAddress(DLLInstance, HelloWorld');
{ вызываем процедуру на выполнение }
HelloWorld(Self);
{ выгружаем DLL из оперативной памяти }
FreeLibrary(DLLInstance);
end;
Как уже говорилось выше, одним из недостатков статической загрузки DLL является невозможность
продолжения работы приложения при отсутствии одной или нескольких библиотек. В случае с динамической
загрузкой у вас появляется возможность программно обрабатывать такие ситуации и не допускать, чтобы программа
вываливалась» самостоятельно. По возвращаемому функциями LoadLibrary и GetProcAddress значениям можно
определить, успешно ли прошла загрузка библиотеки и найдена ли в ней необходимая приложению процедура.
Приведенный ниже код демонстрирует это.
procedure TForm1.DynamicLoadBtnClick(Sender: TObject);
type
THelloWorld = procedure(AForm : TForm);
var
DLLInstance : THandle;
HelloWorld : THelloWorld;
begin
DLLInstance := LoadLibrary('myfirstdll.dll');
if DLLInstance = 0 then begin
MessageDlg('Невозможно загрузить DLL', mtError, [mbOK], 0);
Exit;
end;
@HelloWorld := GetProcAddress(DLLInstance, 'HelloWorld');
if @HelloWorld nil then
HelloWorld (Self)
else
MessageDlg('Не найдена искомая процедура!.', mtError, [mbOK], 0);
FreeLibrary(DLLInstance);
end;
В DLL можно хранить не только код, но и формы.
Причем создание и помещение форм в динамическую библиотеку не слишком сильно отличается от работы
с формами в обычном проекте. Сначала мы рассмотрим, каким образом можно написать библиотеку,
содержащую формы, а затем мы поговорим об использовании технологии MDI в DLL.
Разработку DLL, содержащую форму, я продемонстрирую на примере.
Итак, во-первых, создадим новый проект динамической библиотеки.
Для этого выберем пункт меню File|New, а затем дважды щелкнем на иконку DLL .
После этого вы увидите примерно следующий код:
library Project2;
{здесь были комментарии}
uses
SysUtils,
Classes;
{$R *.RES}
begin
end.
Сохраните полученный проект. Назовем его DllForms.dpr.
Теперь следует создать новую форму. Это можно сделать по-разному.
Например, выбрав пункт меню File|New Form. Добавьте на форму какие-нибудь компоненты.
Назовем форму DllForm и сохраним получившийся модуль под именем DllFormUnit.pas .
Вернемся к главному модулю проекта и поместим в него функцию ShowForm, в задачу которой будет входить
создание формы и ее вывод на экран. Используйте для этого приведенный ниже код.
function ShowForm : Integer; stdcall;
var
Form : TDLLForm;
begin
Form := TDLLForm.Create(Application);
Result := Form.ShowModal;
Form.Free;
end;
Обращаю внимание, что для того, чтобы проект был скомпилирован без ошибок, необходимо добавить в секцию uses модуль Forms .
Экспортируем нашу функцию с использованием ключевого слова exports :
exports
ShowForm;
Компилируем проект и получаем файл dllforms.dll. Эти простые шаги - все,
что необходимо сделать для сОбратите внимание, что функция ShowForm объявлена с использованием ключевого слова stdcall .
Оно сигнализирует компилятору использовать при экспорте функции соглашение
по стандартному вызову (standard call calling convention). Экспорт функции таким образом создает
возможность использования разработанной DLL не только в приложениях, созданных в Delphi.
Соглашение по вызову (Calling conventions) определяет, каким образом передаются аргументы при вызове функции.
Существует пять основных соглашений: stdcall, cdecl, pascal, register и safecall.
Подробнее об этом можно узнать, посмотрев раздел " Calling Conventions " в файле помощи Delphi.
Также обратите внимание, что значение, возвращаемое функцией ShowForm ,
соответствует значению ShowModal. Таким образом вы можете передавать некоторую информацию
о состоянии формы вызывающему приложению.
Ниже представлено два листинга, первый из которых содержит полный код файла
проекта DLL (модуль с формой здесь не приводится), а второй - модуль вызывающего приложения,
в котором используется только что разработанная нами библиотека.
library DllForms;
uses
SysUtils,
Classes,
Forms,
DllFormUnit in 'DllFormUnit.pas' {DllForm};
{$R *.RES}
function ShowForm : Integer; stdcall;
var
Form : TDLLForm;
begin
Form := TDLLForm.Create(Application);
Result := Form.ShowModal;
Form.Free;
end;
begin
end.
unit TestAppUnit;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
function ShowForm : Integer; stdcall;
external 'dllforms.dll';
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowForm;
end;
end.
Прошу заметить, что при экспорте функции также было использовано ключевое слово stdcall.
Следует обратить особое внимание на работу с дочерними формами в DLL. Если, к примеру,
в вызывающем приложении главная форма имеет значение свойства FormStyle, равным MDIForm,
то при попытке вызова из DLL MDIChild-формы, на экране появится сообщение об ошибке,
в котором будет говориться, что нет ни одной активной MDI-формы.
В тот момент, когда вы пытаетесь показать ваше дочернее окно, VCL проверяет корректность
свойства FormStyle главной формы приложения. Однако в нашем случае все вроде бы верно.
Так в чем же дело? Проблема в том, что при проведении такой проверки, рассматривается объект Application,
принадлежащий не вызывающему приложению, а собственно динамической библиотеке.
Ну, и естественно, поскольку в DLL нет главной формы, проверка выдает ошибку.
Для того чтобы избежать такой ситуации, надо назначить объекту Application динамической библиотеки
объект Application вызывающего приложения. Естественно, это заработает только в том случае,
когда вызывающая программа - VCL-приложение. Кроме того, перед выгрузкой библиотеки из памяти
необходимо вернуть значение объекта Application библиотеки в первоначальное состояние.
Это позволит менеджеру памяти очистить оперативную память, занимаемую библиотекой.
Следовательно, вам нужно сохранить указатель на «родной» для библиотеки объект Application
в глобальной переменной, которая может быть использована при восстановлении его значения.
Итак, вернемся немного назад и перечислим шаги, необходимые нам для работы с помещенным
в DLL MDIChild-формами.
В динамической библиотеке создаем глобальную переменную типа TApplication.
Сохраняем указатель на объект Application DLL в глобальной переменной.
Объекту Application динамической библиотеки ставим в соответствие указатель на Application
вызывающего приложения.
Создаем MDIChild-форму и работаем с ней.
Возвращаем в первоначальное состояние значение объекта Application динамической библиотеки
и выгружаем DLL из памяти.
Первый шаг прост. Просто помещаем следующий код в верхней части модуля DLL:
var
DllApp : TApplication;
Затем создаем процедуру, которая будет изменять значение объекта Application и создавать дочернюю форму.
Процедура может выглядеть примерно так:
procedure ShowMDIChild(MainApp : TApplication);
var
Child : TMDIChild;
begin
if not Assigned(DllApp) then begin
DllApp := Application;
Application := MainApp;
end;
Child := TMDIChild.Create(Application.MainForm);
Child.Show;
end;
Все, что нам теперь необходимо сделать, - это предусмотреть возвращение значения объекта Application
в исходное состояние. Делаем это с помощью процедуры MyDllProc:
procedure MyDLLProc(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH then
{ DLL is выгружается. Восстанавливаем значение указателя Application}
if Assigned(DllApp) then
Application := DllApp;
end;
Вместо заключения.
Использование динамически подключаемых библиотек не так сложно, как это может показаться на первый взгляд.
DLL предоставляют широчайшие возможности для оптимизации работы приложений,
а также работы самих программистов. Используйте DLL и, возможно, ваша жизнь станет легче!
Использование динамически подключаемых библиотек не так сложно, как это может показаться на первый взгляд.
DLL предоставляют широчайшие возможности для оптимизации работы приложений,
а также работы самих программистов. Используйте DLL и, возможно, ваша жизнь станет легче!
http://subscribe.ru/
E-mail: ask@subscribe.ru Поиск
на АПОРТ на Subscribe.Ru
Взято с сайта
Загрузка изображений в Blob-поля
Загрузка изображений в Blob-поля
Имеется несколько способов загрузки изображения в BLOB-поле таблицы dBASE или Paradox. Три самых простых метода включают в себя:
копирование данных из буфера обмена Windows в компонент TDBImage, связанный с BLOB-полем
использование метода LoadFromFile компонента TBLOBField
использование метода Assign для копирования объекта типа TBitmap в значение свойства Picture компонента TBDBImage.
Первый способ, когда происходит копирование изображения из буфера обмена, вероятно, наиболее удобен в случае, когда необходимо добавить изображение в таблицу при использовании приложения конечным пользователем. В этом случае компонент TDBImage используется в роли интерфейса между BLOB-полем таблицы и изображением, хранящимся в буфере обмена. Метод PasteFromClipboard компонента TDBImage как раз и занимается тем, что копирует изображение из буфера обмена в TDBImage. При сохранении записи изображение записывается в BLOB-поле таблицы.
Поскольку буфер обмена Windows может содержать данные различных форматов, то желательно перед вызовом метода CopyFromClipboard осуществлять проверку формата хранящихся в нем данных. Для этого необходимо создать объект TClipboard и использовать его метод HasFormat, позволяющий определить формат хранящихся в буфере данных. Имейте в виду, что для создания объекта TClipboard вам необходимо добавить модуль Clipbrd в секцию uses того модуля, в котором будет создаваться экземпляр объекта.
Вот исходный код примера, копирующий содержание буфера обмена в компонент TDBImage, если содержащиеся в буфере данные имеют формат изображения:
procedureTForm1.Button1Click(Sender: TObject);
var
C: TClipboard;
begin
C := TClipboard.Create;
try
if Clipboard.HasFormat(CF_BITMAP) then
DBImage1.PasteFromClipboard
else
ShowMessage('Буфер обмена не содержит изображения!');
finally
C.Free;
end;
end;
Второй способ заполнения BLOB-поля заключается в загрузке изображения непосредственно из файла в BLOB-поле. Данный способ одинаково хорош как при создании приложения (формирование данных), так и при его использовании.
Этот способ использует метод LoadFromFile компонента TBLOBField, который применяется в Delphi для работы с dBASE-таблицами и двоичными Windows полями или таблицами Paradox и графическими Windows полями; в обоих случаях с помощью данного метода возможно загрузить изображение и сохранить его в таблице.
Методу LoadFromFile компонента TBLOBField необходим единственный параметр типа String: имя загружаемого файла с изображением. Значение данного параметра может быть получено при выборе файла пользователем с помощью компонента TOpenDialog и его свойства FileName.
Вот пример, демонстрирующий работу метода LoadFromFile компонента TBLOBField с именем Table1Bitmap (поле с именем Bitmap связано с таблицей TTable, имеющей имя Table1):
procedure TForm1.Button2Clicck(Sender: TObject);
begin
Table1Bitmap.LoadFromFile(
'c:\delphi\images\splash\16color\construc.bmp');
end;
Третий способ для копирования содержимого объекта типа TBitmap в свойство Picture компонента TDBImage использует метод Assign. Объект типа TBitmap может быть как свойством Bitmap свойства-объекта Picture компонента TImage, так и отдельного объекта TBitmap. Как и в методе, копирующем данные из буфера обмена в компонент TDBImage, данные изображения компонента TDBImage сохраняются в BLOB-поле после успешного сохранения записи.
Ниже приведен пример, использующий метод Assign. В нашем случае используется отдельный объект TBitmap. Для помещения изображения в компонент TBitmap был вызван его метод LoadFromFile.
procedure TForm1.Button3Click(Sender: TObject);
var
B: TBitmap;
begin
B := TBitmap.Create;
try
B.LoadFromFile('c:\delphi\images\splashh\16color\athena.bmp');
DBImage1.Picture.Assign(B);
finally
B.Free;
end;
end;
Взято из
Если Вы
Заключение
Если Вы зашли так далеко и поняли все то, о чем я говорил в этой статье - поздравляю Вас! Смотрите, я же говорил, что потоки в COM - это просто. Вы просто должны затратить немного времени, чтобы не спеша понять много нового, но в конце концов потоки они и есть потоки, это просто новое лицо, появляющееся при интеграции с COM. Я надеюсь, что Вы наслаждались чтением этой статьи так же, как я наслаждался написанием этой статьи (и потоковыми моделями).
На этом все. Скоро ждите еще много интересного!
Сайт автора и другие ресурсы по COM www.intac.com/~bly/com/index.htm
Запись и чтение чисел в Blob-поле
Запись и чтение чисел в Blob-поле
Мне нужно записать серию чисел в файл Paradox в blob-поле. Числа получаются из значений компонент, размещенных на форме. Затем мне нужно будет считывать числа из blob-поля и устанавливать согласно им значения компонент. Как мне сделать это?
Вы можете начать свое исследование со следующего модуля:
unitBlobFld;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, DBTables, DB, ExtCtrls, DBCtrls,
Grids, DBGrids;
type
TFrmBlobFld = class(TForm)
BtnWrite: TBitBtn;
Table1: TTable;
DataSource1: TDataSource;
DBNavigator1: TDBNavigator;
LbxDisplayBlob: TListBox;
Table1pubid: TIntegerField;
Table1comments: TMemoField;
Table1UpdateTime: TTimeField;
Table1Real1: TFloatField;
Table1Real2: TFloatField;
Table1Real3: TFloatField;
Table1Curr1: TCurrencyField;
Table1Blobs: TBlobField;
Table1Bytes: TBytesField;
CbxRead: TCheckBox;
procedure BtnWriteClick(Sender: TObject);
procedure DataSource1DataChange(Sender: TObject; Field: TField);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
FrmBlobFld: TFrmBlobFld;
implementation
{$R *.DFM}
type
ADouble = array[1..12] of double;
PADouble = ^ADouble;
procedure TFrmBlobFld.BtnWriteClick(Sender: TObject);
var
i: integer;
myBlob: TBlobStream;
v: longint;
begin
Table1.Edit;
myBlob := TBlobStream.Create(Table1Blobs, bmReadWrite);
try
v := ComponentCount;
myBlob.Write(v, sizeof(longint));
for i := 0 to ComponentCount - 1 do
begin
v := Components[i].ComponentIndex;
myBlob.Write(v, sizeof(longint));
end;
finally
Table1.Post;
myBlob.Free;
end;
end;
procedure TFrmBlobFld.DataSource1DataChange(Sender: TObject; Field: TField);
var
i: integer;
myBlob: TBlobStream;
t: longint;
v: longint;
begin
if CbxRead.Checked then
begin
LbxDisplayBlob.Clear;
myBlob := TBlobStream.Create(Table1Blobs, bmRead);
try
myBlob.Read(t, sizeof(longint));
LbxDisplayBlob.Items.Add(IntToStr(t));
for i := 0 to t - 1 do
begin
myBlob.Read(v, sizeof(longint));
LbxDisplayBlob.Items.Add(IntToStr(v));
end;
finally
myBlob.Free;
end;
end;
end;
procedure TFrmBlobFld.FormShow(Sender: TObject);
begin
Table1.Open;
end;
procedure TFrmBlobFld.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Table1.Close;
end;
end.
Взято из
Как мне в таблице Paradox скопировать массив целочисленных чисел в TBlobField и наоборот? Элементы массива являются точками графика данных, который я хочу выводить, если запись доступна.
Запишите массив в поток памяти и затем используйте метод TBlob LoadFromStream. Для извлечения данных используйте метод TBlob SaveToStream (сохранение и извлечение массива из потока памяти).
Взято из
Запись картинки в ADO таблицу
Запись картинки в ADO таблицу
ADOQuery1.Edit;
TBLOBField(ADOQuery1.FieldByName('myField')).LoadFromFile('c:\my.bmp');
ADOQuery1.Post;
Взято из
Примечание Vit: похоже имеется ввиду квери вида "Select * From..."
Запись массива на диск
Запись массива на диск
Скажем, ваша структура данных выглядит следующим образом:
type
TMyRec = record
SomeField: Integer;
SomeOtherField: Double;
TheRest: array[0..99] of Single;
end;
и TBlobField имеет имя MyBlobField. TMyRec назван как MyRec. Для копирования содержимого MyRec в MyBlobField необходимо сделать следующее:
var
Stream: TBlobStream;
begin
Stream := TBlobStream.Create(MyBlobField, bmWrite);
Stream.Write(MyRec, SizeOf(MyRec));
Stream.Free;
end;
Есть другой путь:
var
Stream: TBlobStream;
begin
Stream := TBlobStream.Create(MyBlobField, bmRead);
Stream.Read(MyRec, SizeOf(MyRec));
Stream.Free;
end;
- Steve Schafer
Взято из
Советов по Delphi от
Сборник Kuliba
Запись потока в BLOB-поле
Запись потока в BLOB-поле
Вся хитрость заключается в использовании StrPcopy (помещения вашей строки в PChar) и записи буфера в поток. Вы не сможете передать это в PChar непосредственно, поскольку ему нужен буфер, поэтому для получения необходимого размера буфера используйте <BufferName>[0] и StrLen().
Вот пример использования TMemoryStream и записи его в Blob-поле:
var
cString: string;
oMemory: TMemoryStream;
Buffer: PChar;
begin
cString := 'Ну, допустим, хочу эту строку!';
{ СОздаем новый поток памяти }
oMemory := TMemoryStream.Create;
{!! Копируем строку в PChar }
StrPCopy(Buffer, cString);
{ Пишем =буфер= и его размер в поток }
oMemory.Write(Buffer[0], StrLen(Buffer));
{Записываем это в поле}
< Blob / Memo / GraphicFieldName > .LoadFromStream(oMemory);
{ Необходимо освободить ресурсы}
oMemory.Free;
end;
Взято из
Записываем в Access используя OLE DB
Записываем в Access используя OLE DB
//Читаем Access`овскую базу используя ADO
// Проверяе являеться ли файл .mdb Access
// Записываем запись в базу
// Нужны компаненты-
// TADOtable,TDataSource,TOpenDialog,TDBGrid,
// TBitBtn,TTimer,TEditTextBox
program ADOdemo;
uses Forms, uMain in 'uMain.pas' {frmMain};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TfrmMain, frmMain);
Application.Run;
end.
///////////////////////////////////////////////////////////////////
unit uMain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, DBTables, ADODB, Grids, DBGrids, ExtCtrls, DBCtrls, StdCtrls, Buttons,
ComObj;
type
TfrmMain = class(TForm)
DBGridUsers: TDBGrid;
BitBtnClose: TBitBtn;
DSource1: TDataSource;
EditTextBox: TEdit;
BitBtnAdd: TBitBtn;
TUsers: TADOTable;
BitBtnRefresh: TBitBtn;
Timer1: TTimer;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure ConnectToAccessDB(lDBPathName, lsDBPassword: string);
procedure ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
procedure AddRecordToMSAccessDB;
function CheckIfAccessDB(lDBPathName: string): Boolean;
function GetDBPath(lsDBName: string): string;
procedure BitBtnAddClick(Sender: TObject);
procedure BitBtnRefreshClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
function GetADOVersion: Double;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmMain: TfrmMain;
Global_DBConnection_String: string;
const
ERRORMESSAGE_1 = 'No Database Selected';
ERRORMESSAGE_2 = 'Invalid Access Database';
implementation
{$R *.DFM}
procedure TfrmMain.FormCreate(Sender: TObject);
begin
ConnectToMSAccessDB('ADODemo.MDB', '123'); // DBName,DBPassword
end;
procedure TfrmMain.ConnectToMSAccessDB(lsDBName, lsDBPassword: string);
var
lDBpathName: string;
begin
lDBpathName := GetDBPath(lsDBName);
if (Trim(lDBPathName) <> '') then
begin
if CheckIfAccessDB(lDBPathName) then
ConnectToAccessDB(lDBPathName, lsDBPassword);
end
else
MessageDlg(ERRORMESSAGE_1, mtInformation, [mbOK], 0);
end;
function TfrmMain.GetDBPath(lsDBName: string): string;
var
lOpenDialog: TOpenDialog;
begin
lOpenDialog := TOpenDialog.Create(nil);
if FileExists(ExtractFileDir(Application.ExeName) + '\' + lsDBName) then
Result := ExtractFileDir(Application.ExeName) + '\' + lsDBName
else
begin
lOpenDialog.Filter := 'MS Access DB|' + lsDBName;
if lOpenDialog.Execute then
Result := lOpenDialog.FileName;
end;
end;
procedure TfrmMain.ConnectToAccessDB(lDBPathName, lsDBPassword: string);
begin
Global_DBConnection_String :=
'Provider=Microsoft.Jet.OLEDB.4.0;' +
'Data Source=' + lDBPathName + ';' +
'Persist Security Info=False;' +
'Jet OLEDB:Database Password=' + lsDBPassword;
with TUsers do
begin
ConnectionString := Global_DBConnection_String;
TableName := 'Users';
Active := True;
end;
end;
// Check if it is a valid ACCESS DB File Before opening it.
function TfrmMain.CheckIfAccessDB(lDBPathName: string): Boolean;
var
UnTypedFile: file of Byte;
Buffer: array[0..19] of Byte;
NumRecsRead: Integer;
i: Integer;
MyString: string;
begin
AssignFile(UnTypedFile, lDBPathName);
reset(UnTypedFile, 1);
BlockRead(UnTypedFile, Buffer, 19, NumRecsRead);
CloseFile(UnTypedFile);
for i := 1 to 19 do
MyString := MyString + Trim(Chr(Ord(Buffer[i])));
Result := False;
if Mystring = 'StandardJetDB' then
Result := True;
if Result = False then
MessageDlg(ERRORMESSAGE_2, mtInformation, [mbOK], 0);
end;
procedure TfrmMain.BitBtnAddClick(Sender: TObject);
begin
AddRecordToMSAccessDB;
end;
procedure TfrmMain.AddRecordToMSAccessDB;
var
lADOQuery: TADOQuery;
lUniqueNumber: Integer;
begin
if Trim(EditTextBox.Text) <> '' then
begin
lADOQuery := TADOQuery.Create(nil);
with lADOQuery do
begin
ConnectionString := Global_DBConnection_String;
SQL.Text :=
'SELECT Number from Users';
Open;
Last;
// Generate Unique Number (AutoNumber in Access)
lUniqueNumber := 1 + StrToInt(FieldByName('Number').AsString);
Close;
// Insert Record into MSAccess DB using SQL
SQL.Text :=
'INSERT INTO Users Values (' +
IntToStr(lUniqueNumber) + ',' +
QuotedStr(UpperCase(EditTextBox.Text)) + ',' +
QuotedStr(IntToStr(lUniqueNumber)) + ')';
ExecSQL;
Close;
// This Refreshes the Grid Automatically
Timer1.Interval := 5000;
Timer1.Enabled := True;
end;
end;
end;
procedure TfrmMain.BitBtnRefreshClick(Sender: TObject);
begin
Tusers.Active := False;
Tusers.Active := True;
end;
procedure TfrmMain.Timer1Timer(Sender: TObject);
begin
Tusers.Active := False;
Tusers.Active := True;
Timer1.Enabled := False;
end;
function TfrmMain.GetADOVersion: Double;
var
ADO: OLEVariant;
begin
try
ADO := CreateOLEObject('adodb.connection');
Result := StrToFloat(ADO.Version);
ADO := Null;
except
Result := 0.0;
end;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
ShowMessage(Format('ADO Version = %n', [GetADOVersion]));
end;
end.
Взято из
Заполняет Canvas рисунком с рабочего стола, учитывая координаты
Заполняет Canvas рисунком с рабочего стола, учитывая координаты
Function PaintDesktop(HDC) : boolean;
Например: PaintDesktop(form1.Canvas.Handle);
Зайцев О.В.
Владимиров А.М.
Взято с Исходников.ru
Запросы на изменение данных
Запросы на изменение данных
А как менять значения в базе данных?
Тоже при помощи квери это делать проще и, что важнее, значительно быстрее. Например, меняем в поле Category все "Cod" на "Kod". В квере пишем текст:Update biolife
Set Category='Kod'
Where Category='Cod'
Ставим на форму кнопку, в обработчике нажания (onClick) пишем код:
Query1.ExecSQL;
Важные примечания:
1) Обратите внимание, что в данном случае мы не открываем квери делая Active:=true и не используем эквивалентный метод Open, а используем метод ExecSQL. Если открытие квери с оператором Select приводит к возвращению данных в программу (так называемый курсор данных), то все остальные типы кверей никаких данных в программу не возвращают - они выполняют операцию над базой, но не возвращают курсор. Такую кверю НЕЛЬЗЯ соединить с визуальными компонентами, её открытие хоть и будет выполнять операцию, будет приводить к исключительной ситуации.
2) Перед изменением текста квери, хоть в дизайне, хоть в run-time кверя должна быть закрыта.
Аналогичным способом можно пользоваться другими операторами SQL:
Delete - для удаления нескольких/всех строк
Insert - для вставки одной или нескольких строк
Create Table - для создания таблицы
Alter Table - для изменения структуры таблицы
Drop Table - для удаления таблицы
и другими. Смотрите руководства по SQL по использованию этих операторов.
Запросы на выбор данных
Запросы на выбор данных
Теперь покажу на примере как можно использовать квери для наиболее простых, но очень частых и нужных операций:
1) Выбор только тех строк (записей) которые отвечают условию (например тех где в поле category записано 'Snapper')
SELECT * FROM biolife
where category='Snapper'
2) Выбор только нужных столбцов (например нам нужны только столбцы Category и common_name )
SELECT Category, common_name FROM biolife
3) Выбор записей отсортированных в определённом порядке (например в алфавитном порядке поля Category)
SELECT * FROM biolife
Order by Category
4) Запрос может комбинировать в себе всё перечисленное
SELECT Category, common_name FROM biolife
where category='Snapper'
Order by common_name
Попробуйте задать каждый из этих запросов и посмотреть как программа будет реагировать на него. На самом деле запросы предоставляют гораздо большии возможности - например суммарные и статистические функции (вычислить сумму всех значений поля), вычисляемые поля (например добавить столбец который отражает не реальное поле в таблице, а сумму 2х других полей), объединение нескольких таблиц в одном запросе (2 таблицы с похожей структурой представляются как одна таблица), запросы на несколько таблиц (например вам надо выбрать всех из одной таблицы которые не встречаются в другой таблице, или для Иванова взять его номер телефона из одной таблицы, а его заказы из другой и т.п.). Всё это вы найдёте здесь: , а в этой статье я только показываю как с этим можно работать из Дельфи
Запущен ли Softice?
Запущен ли Softice?
//SoftIcein W9x
function IsSoftIce95Loaded: boolean;
var
hFile: Thandle;
begin
result := false;
hFile := CreateFileA('\.SICE', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
CloseHandle(hFile);
result := TRUE;
end;
end;
// SoftIce in NT OS
function IsSoftIceNTLoaded: boolean;
var
hFile: Thandle;
begin
result := false;
hFile := CreateFileA('\.NTICE', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
CloseHandle(hFile);
result := TRUE;
end;
end;
//to detect it
if IsSoftIce95Loaded or IsSoftIceNTLoaded then
Application.Terminate
{if you insert a "Nag" (Message telling him he uses SoftIce) then a amatuer cracker w'll find this protection in notime}
//bestway of using this thing is in "project Unit"
Взято с
Delphi Knowledge BaseЗапуск и завершение приложений
Запуск и завершение приложений
Cодержание раздела:
Запуск программы на Kylix
Запуск программы на Kylix
Обычно при запуске приложения на Kylix без самого Kylix выскакивают различные трудно понятные ошибки. Они связаны с тем что приложение не может найти нужные ему библиотеки.
В простейшем случае достаточно предпринять следующие шаги:
1) создать папку
/usr/lib/borland
2) В эту папку скопировать файл libborqt-6.9.0-qt2.3.so с машины где установлен Kylix
3) Создать символьный линк libborqt-6.9-qt2.3.so на этот файл (команда linux ln -s )
4) Отредактирвоать файл в папке /home/[ваш логин] по имени .bash_profile (внимение файл скрытый!)
PATH=$PATH:$HOME/bin:.
export LD_LIBRARY_PATH=/usr/lib/borland
export PATH
5) Убедиться что у пользователя под которым вы собираетесь работать есть права на чтение и запуск libborqt-6.9.0-qt2.3.so и libborqt-6.9-qt2.3.so
5) Перезагрузить компьютер
Автор:
VitВзято из
Защита данных
Защита данных
Давайте принципиально различать 2 ситуации:
Ситуация I
Нужно чтобы программа где-то хранила свои данные в зашифрованном виде. Пользователь никаких паролей не вводит. Такой сценарий обычно нужен чтобы предупредить возможность пользователя напрямую манипулировать теми или иными данными, позволяя ему общение только через программу.
Для этого случая сила криптографических алгоритмов не принципиальна. Против ламера поможет любая защита, против хакера - никакая защита не сработает, так как пароль/ключ и алгоритм уже находятся в руках, всё зашито в базе данных, exe и т.п. у пользователя на компьютере, то так или иначе эта защита вскрывается - программа дизассемблируется, трассируется, запросы к базе перехватываются и т.д. В данном случае что Парадокс, что MS Access, что любая другая база данных - не имеет значения, вопрос в том сломают её за 5 минут или за час.
Ситуация II
Есть конфиденциальные данные конкретного пользователя. Чтобы получить свои данные пользователь должен руками ввести свой пароль. Сам пароль известен только пользователю, ни в програмном коде, ни в базе данных он нигде не хранится.
Вот здесь надо обратить внимание на базу данных. Сразу скажу - базы данных типа Парадокс, Foxpro, MS Access - подходят только если использовать шифрование данных, надеятся на их встроенные системы защиты нельзя. Лучше всего защищены промышленные сервера, типа MS SQL Server, Oracle, DB/2, SyBase. И тем ни менее, даже при их использовании, для максимальной защиты лучше шифровать вносимые данные по какому-нибудь криптостойкому алгоритму, например:
берётся строка: "Логин+Пароль", введенные пользователем
на этой строке делается MD5 - получается 32 битный ключ
Все данные читаются и пишутся с предварительной шифровкой/дешифровкой с полученным ключём использую алгоритм "трипл-дес"
При таком раскладе можно и в парадоксе хранить - расшифровать практически невозможно. Только надо понимать что при таком алгоритме нет никакой возможности восстановить утерянный пароль, обнулить пароль и восстановить инфу при потере логина или пароля - информация будет утеряна навсегда.
Рассмотренные сценарии относятся к случаю, когда база данных поставляется с программой, если используется удалённый сервер баз данных или например для web приложений, то там правила немного другие, надо принимать в рассчёт многочисленные возможности защиты информации на удалённом компьютере.
Автор:
VitВзято из
Защита паролем
Защита паролем
Защита паролем
Статус в HTTP-заголовке
В дополнение к строкам заголовка, которые формирует CGI-программа, сервер выводит дополнительную строку, в которой сообщает о статусе обработки полученного запроса. Например, если запрос обработан успешно, сервер выдает следующую строку в заголовке: HTTP/1.0 200 OK
Запрос на авторизацию
Если вы попробуете запустить без изменений мой "web browser" (см. страницу delphi), то вы увидите, что полученный HTTP заголовок несколько отличается от обычного: HTTP/1.0 401 Unauthorized
Content-type: text/html
WWW-Authenticate: Basic realm="/MyRealm"
<html><head><title>401 Unauthorized</title></head><body>
<h1>Для доступа к этой странице требуется пароль!</h1>
</body></html>
Здесь сервер отсылает предупреждение 401 Unauthorized для того, чтобы ваш браузер знал, что он обратился к защищенной странице. Тем самым, сервер предлагает вам ввести пароль и логин в строке уточнения (realm= "/MyRealm"). Если вы предоставите серверу действительный логин и пароль, то сервер откроет доступ к данной странице. В противном случае браузер будет получать вместо нужной страницы предупреждение с кодом 401.
Формируем запрос на авторизацию
Теперь мы знаем все, что нужно, чтобы наша CGI-программа могла запросить от пользователя пароль для доступа: Program CheckPWD;
{$apptype console}
begin
WriteLn('HTTP/1.0 401 Unauthorized');
WriteLn('Content-type: text/html');
WriteLn('WWW-Authenticate: Basic realm="/Check"');
WriteLn;
WriteLn('Для доступа к этой странице требуется пароль!');
end;
... и, к нашему удивлению, убеждаемся, что такой вариант не работает! Мы получаем либо внутреннюю ошибку сервера, либо браузер выдает полученный текст как обычную страницу, не понимая, что от него требуют ввести пароль!
Спокойно, без паники! Так и должно быть. Я уже говорил, что сервер автоматически дополняет HTTP-заголовок своими сообщениями, и браузер после выполнения программы CheckPWD получит следующее:
HTTP/1.0 200 OK
HTTP/1.0 401 Unauthorized
Content-type: text/html
WWW-Authenticate: Basic realm="/MyRealm"
Для доступа к этой странице требуется пароль!
Первая строка в заголовке говорит о том, что запрос обработан успешно (спасибо серверу). Поэтому браузер и не требует ничего от пользвателя.
У меня есть несколько вариантов выхода из этой ситуации, и один из вариантов заключается в том, что в соответствии с требованиями CGI, имя файла CGI-программы должно начинаться с "nph-", если она сама должна полностью формировать HTTP-заголовок.
Таким образом, достаточно переименовать вышеприведенную программу в "NPH-CHECKPWD.EXE", и все заработает!
Итак, мы добились, чтобы наша CGI-программа заставляла браузер потребовать от пользователя предоставить информацию об авторизации!
WWW-Authenticate
Получив запрос на авторизацию, браузер выводит на экран диалог для ввода пользователем логина и пароля и отправляет их на сервер в виде строки WWW-Authenticate: Basic realm="/MyRealm". В результате, CGI-программа получит от сервера строку авторизации в виде значения переменной среды окружения HTTP_AUTHORIZATION.
HTTP_AUTHORIZATION=Basic dXNlcjpwYXNzd29yZA==
В этой строке как раз и записан введенный логин и пароль, но только не в открытом, а в закодированном виде... Для кодировки строки авторизации используется формат Base64.
Сделаем небольшое отступление об основаниях систем счисления (как всегда - математика рулит!):
·Люди привыкли считать по основанию 10 (т.е. в 10-чной системе счисления): 0..9
·В информатике часто используется 16-ричное представление: 0..9,'A'..'F'
·В интернет очень широко используется представление в системе счисления с основанием 64: 0..9,'A'..'Z','a'..'z','+','/'
В файле LOGIN.ZIP вы найдете пример использования модуля Base64, который осуществляет кодирование и декодирование строк по основанию 64.
Кстати, вышеприведенный текст расшифровывается с помощью Base64 очень просто: "user:password"
Итак, теперь мы можем написать CGI-программу, которая будет либо показывать запрошенную информацию, либо требовать от пользователя авторизации.
Еще одной альтернативой является переадресация на другую страницу, если авторизация не подтверждена.
Практической реализацией изложенных выше принципов является программа login.
Не забудьте переименовать файлы login.exe и login.ini из этого в nph-login.exe и npg-login.ini !
В завершение я предлагаю вашему вниманию программу "CGI Web Browser". Эта программа является консольным приложением Delphi, позволяющим просматривать диски и каталоги на сервере и загружать файлы. Для разрешения доступа к дискам сервера программа требует ввода логина и пароля. (Не забудьте поменять логин/пароль в исходном коде!)
Защита Shareware програм
Защита Shareware програм
Взято из FAQ:
В качестве примера приведен небольшой участок программного кода,
позволяющий быстро создать защиту для программ SHAREWARE,
которая, не влияет на функциональность самой программы,
но настоятельно «просит» ее зарегистрировать и закрывает при каждом повторном запуске.
Технология данного метода заключается в том, что пользователь
может запустить программу только один раз за текущий сеанс Windows. Используйте обработчик события FormShow:
procedure TForm1.FormShow(Sender: TObject);
var
atom: integer;
CRLF: string;
begin
if GlobalFindAtom('THIS_IS_SOME_OBSCUREE_TEXT') = 0 then
atom := GlobalAddAtom('THIS_IS_SOME_OBSCUREE_TEXT')
else
begin
CRLF := #10 + #13;
ShowMessage('Данная версия предусматривает только один запуск'
+ 'в текущем сеансе Windows.' + CRLF
+ 'Для повторного запуска необходимо перезапустить Windows, или,'
+ CRLF + 'что лучше, - ' + CRLF + 'ЗАРЕГИСТРИРУЙТЕСЬ !');
Close;
end;
end;
Преимущество данного метода в том, что пользователю доступны все
возможности программы, но только до момента ее закрытия, или перезапуска системы.
Вся хитрость заключается в сохранении некоторой строки в системных
глобальных переменных («атомах») и последующей проверке ее в таблице «атомов» системы.
Взято с Vingrad.ru
Затенить компонент
Затенить компонент
procedureShadeIt(f: TForm; c: TControl; Width: Integer; Color: TColor);
var
rect: TRect;
old: TColor;
begin
if (c.Visible) then
begin
rect := c.BoundsRect;
rect.Left := rect.Left + Width;
rect.Top := rect.Top + Width;
rect.Right := rect.Right + Width;
rect.Bottom := rect.Bottom + Width;
old := f.Canvas.Brush.Color;
f.Canvas.Brush.Color := Color;
f.Canvas.fillrect(rect);
f.Canvas.Brush.Color := old;
end;
end;
procedure TForm1.FormPaint(Sender: TObject);
var
i: Integer;
begin
for i := 0 to Self.ControlCount - 1 do
ShadeIt(Self, Self.Controls[i], 3, clBlack);
end;
Взято из
Завершение всех работающих приложений
Завершение всех работающих приложений
Как мне завершить все работающие задачи?
Ниже приведен код, который поможет вам завершить ВСЕ задачи без всяких уведомлений о необходимости сохранения данных.
Поэтому, прежде чем запустить этот код, убедитесь в наличии сохраненных данных и в том, что пользователь осведомлен об этой операции.
procedureTForm1.ButtonKillAllClick(Sender: TObject);
var
pTask: PTaskEntry;
Task: Bool;
ThisTask: THANDLE;
begin
GetMem(pTask, SizeOf(TTaskEntry));
pTask^.dwSize := SizeOf(TTaskEntry);
Task := TaskFirst(pTask);
while Task do
begin
if pTask^.hInst = hInstance then
ThisTask := pTask^.hTask
else
TerminateApp(pTask^.hTask, NO_UAE_BOX);
Task := TaskNext(pTask);
end;
TerminateApp(ThisTask, NO_UAE_BOX);
end;
Взято с
Звук
Звук
Cодержание раздела:
См. также другие разделы:
