{$APPTYPE GUI}
program LightLauncher;
uses
windows,
messages,
commctrl,
Graphics,
Perimeter in 'Perimeter.pas',
SocketsUDP in 'SocketsUDP.pas',
cHash in 'cHash.pas';
{$R WindowsXP.res}
{$R resources.RES}
const
WEBTOOLS_ADDR = '127.0.0.1';
WEBTOOLS_PORT = 25564;
WND_CLASS_NAME0 = 'LL_WNDCLASS_0';
WND_CLASS_NAME1 = 'LL_WNDCLASS_1';
CHK_REM = 2000;
TXT_STAT = 2001;
TXT_DOWN = 2002;
BTN_LOGIN = 2003;
EDIT_PASS = 2004;
EDIT_LOGIN = 2005;
TXT_PASS = 2006;
TXT_LOGIN = 2007;
PB_STAT = 2008;
var
BG: TBitmap;
BGDC: HDC;
function wnd_proc0(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; forward; export;
function create_wnd0: HWND; forward;
procedure create_wnd_content0(parent: HWND); forward;
function wnd_proc1(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; forward; export;
function create_wnd1: HWND; forward;
procedure create_wnd_content1(parent: HWND); forward;
var instance: longint;
h_font, h_big: HFONT;
PB, StatText, wnd0: HWND;
Remember: Boolean;
Socket: TSocket;
procedure OnDataRecieved(Data: PClientEventsData);
var
ReceivedData: string;
begin
ReceivedData := PAnsiChar(Data.ReceivedData);
if ReceivedData = 'BAD' then
MessageBox(create_wnd1, 'Неправильные логин или пароль!', 'Ошибка!', MB_ICONERROR);
DestroySocket(Socket);
end;
procedure Auth;
var
Events: TClientEvents;
ConnectionStatus: boolean;
SendData: string;
begin
Socket := CreateClientSocket(WEBTOOLS_ADDR, WEBTOOLS_PORT, ConnectionStatus);
if ConnectionStatus = false then
begin
MessageBox(wnd0, 'Не удалось подключиться к серверу!', 'Ошибка!', MB_ICONERROR);
DestroySocket(Socket);
Exit;
end;
FillChar(Events, SizeOf(Events), #0);
Events.OnRead := OnDataRecieved;
ListenClientSocket(Socket, Events);
end;
procedure SetPBSize(Size: Integer);
begin
SendMessage(PB, PBM_SETPOS, Size, 0);
end;
procedure DrawBG;
var
bmp: HBITMAP;
begin
BG := TBitmap.Create();
BG.PixelFormat := pf24bit;
bmp := LoadBitmap(instance, 'BACKGROUND');
GetObject(bmp, SizeOf(TBitmap), @BG);
BGDC:=CreateCompatibleDC(0);
SelectObject(BGDC, bmp);
end;
function wnd_proc0(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; export;
var
rct: TRect;
begin
case message of
WM_COMMAND:
begin
case LOWORD(w_param) of
BTN_LOGIN:
begin
Auth;
end;
CHK_REM:
begin
Remember := IsDlgButtonChecked(window, CHK_REM) = BST_CHECKED;
end;
end;
end;
WM_CREATE:
begin
create_wnd_content0(window);
end;
WM_ERASEBKGND:
begin
GetClientRect(wnd0, rct);
SetStretchBltMode(w_param, HALFTONE);
StretchBlt(w_param, 0, 0, rct.Right, rct.Bottom, BGDC, 0, 0, BG.Width, BG.Height, SRCCOPY);
end;
WM_CLOSE:
begin
DestroyWindow(window);
end;
WM_DESTROY:
begin
FreeWinSock;
PostQuitMessage(0);
end;
else
begin
wnd_proc0 := DefWindowProc(window, message, w_param, l_param);
exit;
end;
end;
wnd_proc0 := 0;
end;
function wnd_proc1(window: HWND; message: UINT; w_param: WPARAM; l_param: LPARAM): LRESULT; stdcall; export;
begin
case message of
WM_CREATE:
begin
create_wnd_content1(window);
end;
WM_CLOSE:
begin
DestroyWindow(window);
end;
WM_DESTROY:
begin
FreeWinSock;
PostQuitMessage(0);
end;
else
begin
wnd_proc1 := DefWindowProc(window, message, w_param, l_param);
exit;
end;
end;
wnd_proc1 := 0;
end;
function create_wnd0: HWND;
var
wnd: HWND;
begin
wnd := CreateWindowEx($00000100, WND_CLASS_NAME0, 'LightLauncher ', WS_VISIBLE or WS_SYSMENU or WS_MINIMIZEBOX, 100, 200, 510, 368, 0, 0, instance, nil);
UpdateWindow(wnd);
create_wnd0 := wnd;
wnd0 := wnd;
end;
function create_wnd1: HWND;
var
wnd: HWND;
begin
wnd := CreateWindowEx($00000100, WND_CLASS_NAME1, 'LightLauncher - Загрузка файлов', WS_VISIBLE or WS_SYSMENU or WS_MINIMIZEBOX, 100, 200, 674, 300, 0, 0, instance, nil);
UpdateWindow(wnd);
create_wnd1 := wnd;
end;
procedure create_wnd_content0(parent: HWND);
var
wnd: HWND;
begin
wnd := CreateWindowEx($00000000, 'Static', 'Логин', $50000300, 111, 170, 40, 14, parent, HMENU(TXT_LOGIN), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
wnd := CreateWindowEx($00000000, 'Static', 'Пароль', $50000300, 108, 193, 44, 20, parent, HMENU(TXT_PASS), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
wnd := CreateWindowEx($00000200, 'Edit', '', $50010080, 154, 163, 210, 24, parent, HMENU(EDIT_LOGIN), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
wnd := CreateWindowEx($00000200, 'Edit', '', $500100A0, 154, 192, 210, 24, parent, HMENU(EDIT_PASS), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
wnd := CreateWindowEx($00000000, 'Button', 'Войти', $50012F00, 173, 258, 150, 47, parent, HMENU(BTN_LOGIN), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
wnd := CreateWindowEx($00000000, 'Button', 'Запомнить меня', $50010003, 107, 216, 115, 35, parent, HMENU(CHK_REM), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
end;
procedure create_wnd_content1(parent: HWND);
var
wnd: HWND;
begin
wnd := CreateWindowEx($00000000, 'Static', 'Идёт загрузка файлов', $50000300, 240, 42, 258, 52, parent, HMENU(TXT_DOWN), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_big), 1);
wnd := CreateWindowEx($00000000, 'Static', 'x/x Мб. (x кб/с)', $50000300, 280, 216, 144, 26, parent, HMENU(TXT_STAT), instance, nil);
SendMessage(wnd, WM_SETFONT, WPARAM(h_font), 1);
StatText := wnd;
wnd := CreateWindowEx($00000000, 'msctls_progress32', '', WS_CHILD or WS_VISIBLE, 120, 100, 430, 40, parent, HMENU(PB_STAT), instance, nil);
SendMessage(wnd, PBM_SETRANGE, 0, MakeLong(0, 100));
PB := wnd;
end;
procedure register_classes;
var wc: WNDCLASS;
begin
wc.cbClsExtra := 0;
wc.cbWndExtra := 0;
wc.hbrBackground := HBRUSH(COLOR_3DFACE + 1);
wc.hCursor := LoadCursor(0, IDC_ARROW);
wc.hIcon := LoadIcon(instance, 'AppIcon');
wc.hInstance := instance;
wc.lpszMenuName := nil;
wc.style := CS_PARENTDC or CS_DBLCLKS;
wc.lpfnWndProc := @wnd_proc0;
wc.lpszClassName := WND_CLASS_NAME0;
RegisterClass(wc);
wc.lpfnWndProc := @wnd_proc1;
wc.lpszClassName := WND_CLASS_NAME1;
RegisterClass(wc);
end;
function message_loop: integer;
var message: MSG;
begin
while GetMessage(message, 0, 0, 0) do
begin
TranslateMessage(message);
DispatchMessage(message);
end;
message_loop := message.wParam;
end;
BEGIN
instance := GetModuleHandle(nil);
InitCommonControls;
register_classes;
h_font := CreateFont(-13, 0, 0, 0, FW_NORMAL, 0,
0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'Times New Roman');
h_big := CreateFont(-22, 0, 0, 0, FW_NORMAL, 0,
0, 0, ANSI_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
DEFAULT_QUALITY, DEFAULT_PITCH or FF_DONTCARE, 'Times New Roman');
ShowWindow(create_wnd0, SW_SHOWNORMAL);
DrawBG;
InitWinSock;
message_loop;
END.