Навигация
Главная
Поиск
Форум
FAQ's
Ссылки
Карта сайта
Чат программистов

Статьи
-Delphi
-C/C++
-Turbo Pascal
-Assembler
-Java/JS
-PHP
-Perl
-DHTML
-Prolog
-GPSS
-Сайтостроительство
-CMS: PHP Fusion
-Инвестирование

Файлы
-Для программистов
-Компонеты для Delphi
-Исходники на Delphi
-Исходники на C/C++
-Книги по Delphi
-Книги по С/С++
-Книги по JAVA/JS
-Книги по Basic/VB/.NET
-Книги по PHP/MySQL
-Книги по Assembler
-PHP Fusion MOD'ы
-by Kest
Professional Download System
Реклама
Услуги

Автоматическое добавление статей на сайты на Wordpress, Joomla, DLE
Заказать продвижение сайта
Программа для рисования блок-схем
Инженерный калькулятор онлайн
Таблица сложения онлайн
Популярные статьи
OpenGL и Delphi... 65535
Форум на вашем ... 65535
HACK F.A.Q 65535
Бип из системно... 65535
Гостевая книга ... 65535
Invision Power ... 65535
Пример работы с... 65535
Содержание сайт... 65535
ТЕХНОЛОГИИ ДОСТ... 65535
Организация зап... 65535
Вызов хранимых ... 65535
Создание отчето... 65535
Программируемая... 65535
Эмулятор микроп... 65535
Подключение Mic... 65535
Создание потоко... 65535
Приложение «Про... 65535
Оператор выбора... 65535
Модуль Forms 65535
Имитационное мо... 60528
Реклама
Сейчас на сайте
Гостей: 10
На сайте нет зарегистрированных пользователей

Пользователей: 13,117
новичок: Asit
Новости
Реклама
Выполняем курсовые и лабораторные по разным языкам программирования
Подробнее - курсовые и лабораторные на заказ
Delphi, Turbo Pascal, Assembler, C, C++, C#, Visual Basic, Java, GPSS, Prolog, 3D MAX, Компас 3D
Заказать программу для Windows Mobile, Symbian

Моделирование процесса поступления заявок в систему, состоящую из трёх Э...
Меры близости на векторах в Delphi + Блок схемы
База данных электронного документооборота на Delphi + бд Intebase

Реклама



Подписывайся на YouTube канал о программировании, что бы не пропустить новые видео!

ПОДПИСЫВАЙСЯ на канал о программировании
клиент/сервер с классами на дельфи 7
Сервер
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, ScktComp, ComCtrls, mesage;

type

sUser = record
Name, Pass : String[32]; //логин и пароль
end;

PSock = ^TSock; // Указатель на динамическую структуру...
TSock = record
Key: String[32]; //ID клиента
end;

TServer = class(TForm)
ServerSocket1: TServerSocket;
LabeledEdit1: TLabeledEdit;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
ListBox1: TListBox;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
procedure SetReg(user : sUser);
function Encrypt(const str : String; key : byte) : String; // функция шифрования
function Decrypt(const cryptstr : String; key : byte) : String; // функция расшифровки
function IsLoginExists(user : sUser; reg : boolean) : boolean;
function AddUser(login : string) : boolean;
function FndandDelFile(name : string) : string;
public
{ Public declarations }
end;

var
Server: TServer;
start : boolean;
datasize : integer;
let : TFileStream;
recive : boolean;
filename, msg_to, msg_from : string;
FPipeRead: THandle;
FPipeWrite: THandle;
FDataLen: DWORD;
FDataRead: DWORD;

implementation

{$R *.dfm}
//открываем порт
procedure TServer.BitBtn1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ServerSocket1.Port := StrToInt(LabeledEdit1.Text);
ServerSocket1.Open;
BitBtn2.Enabled := true;
BitBtn1.Enabled := false;
LabeledEdit1.Enabled := false;
end;

//закрываем порт
procedure TServer.BitBtn2Click(Sender: TObject);
begin
ListBox1.Items.Clear;
if ServerSocket1.Active = true then ServerSocket1.Close;
BitBtn1.Enabled := true;
BitBtn2.Enabled := false;
LabeledEdit1.Enabled := true;
end;

//сохраняем файл с логинами и паролями
procedure TServer.SetReg(user : sUser);
var fl, tmp : TFileStream;
sz : Integer;
Usr : sUser;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + '\DBases\') then
CreateDir(ExtractFilePath(Application.ExeName) + '\DBases\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('users.cs') then
begin
fl := TFileStream.Create('users.cs', fmOpenRead);
tmp := TFileStream.Create('users.tmp', fmCreate);
fl.Read(sz, 4);
sz := sz + 1;
tmp.Write(sz, 4);
tmp.CopyFrom(fl, fl.Size - 4);
fl.Free;
end
else
begin
tmp := TFileStream.Create('users.cs', fmCreate);
sz := 1;
tmp.Write(sz, 4);
end;
Usr.Name := Encrypt(user.Name, 128);
Usr.Pass := Encrypt(user.Pass, 128);
sz := sizeof(Usr);
tmp.Write(sz, 4);
tmp.Write(Usr, sz);
tmp.Free;
if FileExists('users.tmp') then
begin
CopyFile('users.tmp', 'users.cs', False);
DeleteFile('users.tmp');
end;
end;

function TServer.Encrypt(const str : String; key : byte) : String; //шифруем сроку
var i : Integer;
tmp, cryptstr : String;
begin
for i:=1 to Length(str) do
begin
tmp := chr(ord(str[i]) xor key);
cryptstr := cryptstr + tmp;
end;
Result := cryptstr;
end;

function TServer.Decrypt(const cryptstr : String; key : byte) : String; //расшифруем сроку
var i : Integer;
tmp, decryptstr : String;
begin
for i:=1 to Length(cryptstr) do
begin
tmp := chr(ord(cryptstr[i]) xor key);
decryptstr := decryptstr + tmp;
end;
Result := decryptstr;
end;

//проверяем при регистрации: не занят ли логин, а также при входе - логин и пароль
function TServer.IsLoginExists(user : sUser; reg : boolean) : boolean;
var fl : TFileStream;
sz, len, i : Integer;
str : String;
Usr : sUser;
begin
Result := false;
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\');
if FileExists('users.cs') then
begin
fl := TFileStream.Create('users.cs', fmOpenRead);
fl.Read(len, 4);
for i := 1 to len do
begin
fl.Read(sz, 4);
fl.Read(Usr, sz);
str := Decrypt(Usr.Name, 128);
if user.Name = str then
begin
Result := true;
if reg = false then
begin
str := Decrypt(Usr.Pass, 128);
if str <> user.Pass then Result := false;
end;
break;
end;
end;
fl.Free;
end;
end;

//закрываем сервер
procedure TServer.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket1.Active = true then ServerSocket1.Close;
end;

//добавляем нового активного пользователя
function TServer.AddUser(login : string) : boolean;
var i : integer;
begin
Result := true;
for i:=0 to ListBox1.Items.Count-1 do
begin
if login = ListBox1.Items.Strings[i] then
begin
Result := false;
break;
end;
end;
if Result = true then ListBox1.Items.Add(login);
end;

//обновляем список активных пользователей при отключении одного
procedure TServer.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var i : integer;
begin
ListBox1.Items.Clear;
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(M_AUT);
end;

//конструктор формы
procedure TServer.FormCreate(Sender: TObject);
begin
recive := false;
end;

procedure TServer.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var msg : String;
buf : char;
len : BYTE;
i, sz: integer;
User : sUser;
Buffer: PChar;
dummy: Cardinal;
_data : PSock;
mes : TMesage;
begin
mes := TMesage.Create;
if recive = false then
begin
mes.mesage := Socket.ReceiveText;
case mes.TypeMessage of
R_UID : //получаем ID пользователя
begin
New(_data);
_data.Key := mes.mesage;
ServerSocket1.Socket.Connections[ServerSocket1.Socket.ActiveConnections-1].Data := _data;
end;
R_FIN : //сообщении о том, что пользователь получил сообщение и его можно удалять
begin
msg := mes.NextMessage(true);
if FileExists(ExtractFilePath(Application.ExeName) + '\DBases\' + msg +'\' + mes.mesage) then
DeleteFile(ExtractFilePath(Application.ExeName) + '\DBases\' + msg +'\' + mes.mesage);
filename := FndandDelFile(msg);
if filename <> '' then //если еще есть сообщения для данного пользователя
mes.mesage := M_SND;
mes.AddToMessage(msg, true);
mes.AddToMessage(filename, false); // отправляем сообщения о готоности отправки следующего письма
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
end;
R_REG : //регистрация нового пользователя
begin
User.Name := mes.NextMessage(true);
User.Pass := mes.NextMessage(true);
msg := mes.mesage;
if IsLoginExists(User, true) = false then
begin
SetReg(User);
mes.mesage := M_ENT + mes.mesage; //успешная регистрация
end
else
begin
mes.mesage := M_BAD;
mes.AddToMessage(msg, true);
mes.AddToMessage('Пользователь с таким логином уже существует!', false);
end;
//отправляем сообщение о результатах регистрации
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
end;
R_ENT : //вход пользователя
begin
User.Name := mes.NextMessage(true);
User.Pass := mes.NextMessage(true);
msg := mes.mesage;
if IsLoginExists(User, false) = true then
begin
mes.mesage := M_ENT + msg; //успешный вход
AddUser(User.Name);
end
else
begin
mes.mesage := M_BAD;
mes.AddToMessage(msg, true);
mes.AddToMessage('Неверные логин/пароль!', false);
end;
//отправляем сообщение о результатах входа
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
end;
R_AUT : ListBox1.Items.Add(mes.mesage); //получаем логин при опросе клиентов
R_OFF : //проверяем наличие сообщений для пользователя из офф-лайна
begin
msg := mes.mesage;
filename := FndandDelFile(msg);
if filename <> '' then
begin
mes.mesage := M_SND;
mes.AddToMessage(msg, true);
mes.AddToMessage(filename, false);
// отправляем сообщения о готоности отправки следующего сообщения
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
end;
end;
R_USR : //проверяем: существует ли пользователь с таким логином
begin
msg := mes.NextMessage(true);
User.Name := mes.mesage;
if IsLoginExists(User, true) = false then
begin
mes.mesage := M_BAD;
mes.AddToMessage(msg, true);
mes.AddToMessage('Пользователя с таким логином не существует!', false);
end
else
begin
mes.mesage := M_USR;
mes.AddToMessage(msg, true);
mes.AddToMessage(User.Name, false); //пользователь существует
end;
//отправляем сообщение о результате проверки
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
end;
R_SND :
begin
msg_from := mes.NextMessage(true);
msg_to := mes.NextMessage(true);
filename := mes.NextMessage(true);
msg := mes.mesage;
if not DirectoryExists(ExtractFilePath(Application.ExeName) + '\DBases\' + msg_to +'\') then
CreateDir(ExtractFilePath(Application.ExeName) + '\DBases\'+ msg_to +'\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\DBases\'+ msg_to +'\');
recive := true;
mes.mesage := M_YES + msg_from; //передаем сообщение о том, что готовы принять файл
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
begin
if PSock(ServerSocket1.Socket.Connections[i].Data)^.Key = msg then
begin
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
break;
end;
end;
CreatePipe(FPipeRead, FPipeWrite, nil, $8000);
FDataLen:=0;
end;
R_YES : //принимаем сообщение от пользователя, что он готов принять файл и отправляем его
begin
let := TFileStream.Create(filename, fmOpenRead);
try
sz := let.Size;
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
begin
if PSock(ServerSocket1.Socket.Connections[i].Data)^.Key = mes.mesage then
begin
ServerSocket1.Socket.Connections[i].SendBuf(sz, SizeOf(sz));
ServerSocket1.Socket.Connections[i].SendStream(let);
end;
end;
except
let.Free;
end;
end;
end;
end
else
begin
//принимаем файл
sz:=Socket.ReceiveLength;
Buffer:=GetMemory(sz);
try
sz:=Socket.ReceiveBuf(Buffer^, sz);
WriteFile(FPipeWrite, Buffer^, sz, dummy, nil);
finally
FreeMemory(Buffer);
end;
while True do
begin
sz:=GetFileSize(FPipeRead, nil);
if sz=0 then Break;
if FDataLen=0 then
begin
if sz ReadFile(FPipeRead, FDataLen, SizeOf(DWORD), dummy, nil);
FDataRead:=0;
let:=TFileStream.Create(filename, fmCreate);
end
else
begin
Buffer:=GetMemory(sz);
try
ReadFile(FPipeRead, Buffer^, sz, dummy, nil);
let.Write(Buffer^, sz);
Inc(FDataRead, sz);
if FDataRead=FDataLen then
begin
let.Free;
recive := false;
CloseHandle(FPipeWrite);
CloseHandle(FPipeRead);
FDataLen:=0;
mes.mesage := M_SND;
mes.AddToMessage(msg_to, true);
mes.AddToMessage(filename, false);
//отправляем сообщенbе о том, что файл принят его можно передавать дальше по назначению
for i := 0 to ServerSocket1.Socket.ActiveConnections-1 do
ServerSocket1.Socket.Connections[i].SendText(mes.mesage);
end;
finally
FreeMemory(Buffer);
end;
end;
end;
end;
mes.Free;
end;

//проверяем наличие файлов в очереди на отправку
function TServer.FndandDelFile(name : string) : string;
var sr : TSearchRec;
done : integer;
tmp : String;
begin
Result := '';
if DirectoryExists(ExtractFilePath(Application.ExeName) + '\Dbases\'+ name + '\') then
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + '\Dbases\' +name + '\');
tmp := '*.*';
done := FindFirst(tmp, faAnyFile, sr);
while done = 0 do
begin
if ExtractFileExt(sr.Name) = '.snd' then
begin
Result := sr.Name;
break;
end;
done := FindNext(sr);
end;
FindClose(sr);
end;
end;


end.




unit mesage;

interface

const
//неизвестный идентификатор
R_ERR = -1;
//ошибки входа/регистрации
M_BAD = '#M';
R_BAD = 0;
//успешный вход
M_ENT = '#E';
R_ENT = 1;
//авторизация пользователя
M_AUT = '#A';
R_AUT = 2;
//проверка существования пользователя
M_USR = '#U';
R_USR = 3;
//подтверждение отправки письма
M_YES = '#Y';
R_YES = 4;
//отправка письма
M_SND = '#S';
R_SND = 5;
//проверка сообщений в оффлайне
M_OFF = '#X';
R_OFF = 6;
//проверка ID клиента
M_UID = '#Z';
R_UID = 7;
//завершение отправки письма
M_FIN = '#F';
R_FIN = 8;
//регистрация нового пользователя
M_REG = '#R';
R_REG = 9;
type

TMesage = class //класс для обработки сообщений
public
mesage : String; //само сообщение
function TypeMessage() : integer;
function NextMessage(size : boolean) : String;
procedure AddToMessage(str: string; size : boolean);
end;
implementation


//определяем тип сообщения
function TMesage.TypeMessage() : integer;
var str : string;
begin
str := Copy(mesage, 1, 2);
Delete(mesage, 1, 2);
Result := R_ERR;
if str = M_BAD then
begin
Result := R_BAD;
end
else
begin
if str = M_ENT then
begin
Result := R_ENT;
end
else
begin
if str = M_AUT then
begin
Result := R_AUT;
end
else
begin
if str = M_USR then
begin
Result := R_USR;
end
else
begin
if str = M_YES then
begin
Result := R_YES;
end
else
begin
if str = M_SND then
begin
Result := R_SND;
end
else
begin
if str = M_OFF then
begin
Result := R_OFF;
end
else
begin
if str = M_UID then
begin
Result := R_UID;
end
else
begin
if str = M_FIN then
begin
Result := R_FIN;
end
else
begin
if str = M_REG then Result := R_REG;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;

function TMesage.NextMessage(size : boolean) : String;
var buf : char;
len : BYTE;
begin
if size = true then
begin //узнаем параметр с учетом его размера в количестве символов
buf := mesage[1];
len := BYTE(buf);
Delete(mesage, 1, 1);
Result := Copy(mesage, 1, len);
Delete(mesage, 1, len);
end
else
begin //безразмерный параметр
Result := mesage;
end;
end;

procedure TMesage.AddToMessage(str: string; size : boolean);
var buf : char;
len : BYTE;
begin
if size = true then
begin //добавляем параметр к сообщению с учетом его размера в количестве символов
len := Length(str);
buf := char(len);
mesage := mesage + buf + str;
end
else
begin //безразмерный параметр
mesage := mesage + str;
end;
end;

end.





Клиент:
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls, Grids,
DB, DBTables, mesage, Outline;


type
sLetter = record //структура, описывающая письма
Name, From : String[32]; //кому и от кого
Theme : String[255]; //тема письма
Date : TDateTime; //время создания
Sz : integer; //размер
end;

TPost = class (TObject) //класс для просмотра писем
constructor Create; overload;
public
Body : TStringList; //тело письма
Letter : sLetter;
Level : integer; //уровень
num : integer; //порядковый номер в базе
typ : boolean; //тип письма: true - входящие, false - исходящие
end;

TClient = class(TForm)
ClientSocket1: TClientSocket;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
LabeledEdit1: TLabeledEdit;
LabeledEdit2: TLabeledEdit;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
BitBtn5: TBitBtn;
Panel1: TPanel;
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
RichEdit1: TRichEdit;
OutLine1: TOutline;
BitBtn7: TBitBtn;
BitBtn6: TBitBtn;
BitBtn8: TBitBtn;
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure BitBtn3Click(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BitBtn5Click(Sender: TObject);
procedure BitBtn7Click(Sender: TObject);
procedure OutLine1Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure BitBtn6Click(Sender: TObject);
procedure BitBtn8Click(Sender: TObject);
private
{ Private declarations }
function SendLetter(): string;
procedure SaveLetter(name : String; inbox : boolean);
procedure OpenPost;
procedure DeleteLetter(ind : integer; inbox : boolean);
procedure FndandDelFile;
public
{ Public declarations }
r_i : boolean;
login : string;
function GetKey : Longint;

end;

var
Client: TClient;
key, filename : string;
List : TStringList;
s_let : boolean;
recive : boolean;
let : TFileStream;
FPipeRead: THandle;
FPipeWrite: THandle;
FDataLen: DWORD;
FDataRead: DWORD;

implementation
uses Unit2, Unit3;

{$R *.dfm}
//соединяемся с сервером
procedure TClient.BitBtn1Click(Sender: TObject);
begin
ClientSocket1.Host := LabeledEdit1.Text;
ClientSocket1.Port := StrToInt(LabeledEdit2.Text);
ClientSocket1.Open;
end;

//закрываем соединение
procedure TClient.BitBtn2Click(Sender: TObject);
begin
ClientSocket1.Close;
end;

//открываем форму входа/регистрации
procedure TClient.BitBtn3Click(Sender: TObject);
begin
if ( r_i = false ) and ( ClientSocket1.Active = true ) then
begin
Authorisation := TAuthorisation.Create(Application);
Authorisation.Tag := TBitBtn(Sender).Tag;
Authorisation.Show;
end;
end;

//действие при подключении
procedure TClient.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
BitBtn2.Enabled := true;
BitBtn3.Enabled := true;
BitBtn4.Enabled := true;
BitBtn1.Enabled := false;
LabeledEdit1.Enabled := false;
LabeledEdit2.Enabled := false;
List := TStringList.Create;
s_let := false;
Key := IntToStr(GetKey);
Socket.SendText('#Z' + Key); //сообщаем ID серверу
end;

//действия при отключении
procedure TClient.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
BitBtn2.Enabled := false;
BitBtn3.Enabled := false;
BitBtn4.Enabled := false;
BitBtn5.Enabled := false;
BitBtn7.Enabled := false;
BitBtn8.Enabled := false;
BitBtn6.Enabled := false;
BitBtn1.Enabled := true;
Panel1.Visible := false;
LabeledEdit1.Enabled := true;
LabeledEdit2.Enabled := true;
if r_i = true then Authorisation.Visible := false;
r_i := false;
OutLine1.Lines.Clear;
FndandDelFile;
end;

procedure TClient.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var sz: integer;
Buffer: PChar;
dummy: Cardinal;
mes : TMesage;
begin
mes := TMesage.Create;
if recive = false then
begin
mes.mesage := Socket.ReceiveText;
case mes.TypeMessage of
R_BAD : //получакм сообщение об ошибке входа регистрации
begin
if (r_i = true) and (Authorisation.key = mes.NextMessage(true) ) then ShowMessage(mes.mesage);
if (r_i = false) and (Panel1.Visible = true ) and (login = mes.NextMessage(true)) then
begin
ShowMessage(mes.mesage);
s_let := false;
end;
end;
R_ENT :
begin
if (r_i = true) and (mes.mesage = Authorisation.key ) then
begin
login := Authorisation.LabeledEdit3.Text;
OpenPost;
Authorisation.Close;
BitBtn5.Enabled := true;
BitBtn3.Enabled := false;
BitBtn4.Enabled := false;
BitBtn6.Enabled := true;
mes.mesage := M_OFF + login; //отправляем серверу сообщение о том, что мы вошли и хотим проверить - не было ли чообщений в наше отсутствие
Socket.SendText(mes.mesage);
end;
end;
R_AUT :
begin
mes.mesage := M_AUT + login; //сообщаем серверу логин
Socket.SendText(mes.mesage);
end;
R_USR : //принимаем сообщение о том, что юзер существует и мы готовы отправить на сервер сообщение для него
begin
if s_let = true then
begin
s_let := false;
filename := SendLetter();
mes.mesage := M_SND;
mes.AddToMessage(login, true);
mes.AddToMessage(LabeledEdit3.Text, true);
mes.AddToMessage(filename, true);
mes.AddToMessage(Key, false);
Socket.SendText(mes.mesage);
end;
end;
R_YES : //тправляем письмо на сервер
begin
if mes.mesage = login then
begin
let := TFileStream.Create(filename, fmOpenRead);
try
sz := let.Size;
Socket.SendBuf(sz, SizeOf(sz));
ClientSocket1.Socket.SendStream(let);
except
let.Free;
end;
end;
end;
R_SND : //готовимся к приему письма
begin
if login = mes.NextMessage(true) then
begin
filename := mes.mesage;
mes.mesage := M_YES + key;
Socket.SendText(mes.mesage);
recive := true;
if not DirectoryExists(ExtractFilePath(Application.ExeName) + login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
CreatePipe(FPipeRead, FPipeWrite, nil, $8000);
FDataLen:=0;
end;
end;
end;
end
else
//прием письма
begin
sz:=Socket.ReceiveLength;
Buffer:=GetMemory(sz);
try
sz:=Socket.ReceiveBuf(Buffer^, sz);
WriteFile(FPipeWrite, Buffer^, sz, dummy, nil);
finally
FreeMemory(Buffer);
end;
while True do
begin
sz:=GetFileSize(FPipeRead, nil);
if sz=0 then Break;
if FDataLen=0 then
begin
if sz ReadFile(FPipeRead, FDataLen, SizeOf(DWORD), dummy, nil);
FDataRead:=0;
let:=TFileStream.Create(filename, fmCreate);
end
else
begin
Buffer:=GetMemory(sz);
try
ReadFile(FPipeRead, Buffer^, sz, dummy, nil);
let.Write(Buffer^, sz);
Inc(FDataRead, sz);
if FDataRead=FDataLen then
begin
let.Free;
recive := false;
CloseHandle(FPipeWrite);
CloseHandle(FPipeRead);
SaveLetter(filename, false);
OpenPost;
Outline1.SelectedItem := OutLine1.Lines.Count;
OutLine1Click(nil);
SetForeGroundWindow(Handle);
Beep;
ShowMessage('Вам письмо!'); //сообщаем об этом пользователю, а так же отправляем серверу сообщение о том, что письмо получено
mes.mesage := M_FIN;
mes.AddToMessage(login, true);
mes.AddToMessage(filename, false);
Socket.SendText(mes.mesage);
FDataLen:=0;
end;
finally
FreeMemory(Buffer);
end;
end;
end;
end;
mes.Free;
end;

//конструктор формы
procedure TClient.FormCreate(Sender: TObject);
begin
r_i := false;
end;

//завершение работы
procedure TClient.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ClientSocket1.Active = true then ClientSocket1.Close;
end;

//конструктор класса для работы с почтой
constructor TPost.Create;
begin
Body := TStringList.Create;
end;

//готовимся отправить письмо
procedure TClient.BitBtn5Click(Sender: TObject);
begin
Panel1.Visible := true;
BitBtn7.Enabled := true;
LabeledEdit3.EditLabel.Caption := 'Кому:';
LabeledEdit3.Text := '';
LabeledEdit4.Text := '';
RichEdit1.Lines.Clear;
end;

//формируем файл для отправки
function TClient.SendLetter(): string;
var let, body : TFileStream;
struct : sLetter;
len : Integer;
name : string;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
name := IntToStr(GetKey) + '.snd';
let := TFileStream.Create(name, fmCreate);
RichEdit1.Lines.SaveToFile('rich.tmp');
body := TFileStream.Create('rich.tmp', fmOpenRead);
struct.Name := LabeledEdit3.Text;
struct.From := login;
struct.Theme := LabeledEdit4.Text;
struct.Date := Now;
struct.Sz := body.Size;
len := sizeof(struct);
let.Write(len, 4);
let.Write(struct, len);
let.CopyFrom(body, body.Size);
let.Free;
body.Free;
DeleteFile('rich.tmp');
Result := name;
SaveLetter(name, true);
OpenPost;
end;

//получаем уникальный ID
function TClient.GetKey : Longint;
var key, tmp : Longint;
getst : TSystemTime;
begin
GetLocalTime(getst);
key := GetTickCount();
tmp := Longint(getst.wDay) * Longint(24) * Longint(3600);
key := key + tmp;
tmp := Longint(getst.wMonth) * Longint(30) * Longint(24) * Longint(3600);
key := key + tmp;
Result := key;
end;

//проверяем - существует ли адресат
procedure TClient.BitBtn7Click(Sender: TObject);
var str : AnsiString;
buf : char;
len : BYTE;
begin
len := Length(login);
buf := char(len);
str := '#U' + buf + login + LabeledEdit3.Text;
ClientSocket1.Socket.SendText(str);
s_let := true;
end;

//сохраняем переписку
procedure TClient.SaveLetter(name : String; inbox : boolean);
var yang, old : TFileStream;
nm : string;
sz : integer;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
if inbox = true then
begin
nm := 'out.cs'; //исходящие
end
else
begin
nm := 'in.cs'; //входящие
end;
if FileExists(nm) then
begin
old := TFileStream.Create(nm, fmOpenRead);
yang := TFileStream.Create('tmp.tmp', fmCreate);
old.Read(sz, 4);
sz := sz + 1;
yang.Write(sz, 4);
yang.CopyFrom(old, old.Size - 4);
old.Free;
end
else
begin
yang := TFileStream.Create(nm, fmCreate);
sz := 1;
yang.Write(sz, 4);
end;
old := TFileStream.Create(name, fmOpenRead);
sz := old.Size;
yang.Write(sz, 4);
yang.CopyFrom(old, sz);
yang.Free;
old.Free;
if FileExists('tmp.tmp') then
begin
CopyFile('tmp.tmp', PChar(nm), False);
DeleteFile('tmp.tmp');
end;
end;

//открываем переписку
procedure TClient.OpenPost;
var pos, len, sz, i: integer;
old, yang : TFileStream;
Letter : sLetter;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
OutLine1.Lines.Clear;
OutLine1.Lines.AddObject(login, TPost.Create);
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Level := 0;
pos := OutLine1.AddChildObject(1,'Исходящие', TPost.Create);
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Level := 1;
if FileExists('out.cs') then
begin
old := TFileStream.Create('out.cs', fmOpenRead);
old.Read(len, 4);
for i:=0 to len-1 do
begin
old.Read(sz, 4);
old.Read(sz, 4);
old.Read(Letter, sz);
yang := TFileStream.Create('rich.tmp', fmCreate);
yang.CopyFrom(old, Letter.Sz);
yang.Free;
OutLine1.AddChildObject(pos, DateTimeToStr(Letter.Date) + ' ' + Letter.Name + ' (' + Letter.Theme +')', TPost.Create);
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Level := 2;
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Letter := Letter;
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Body.LoadFromFile('rich.tmp');
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).typ := false;
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).num := i;
DeleteFile('rich.tmp');
end;
old.Free;
end;
pos := OutLine1.AddChildObject(1, 'Входящие', TPost.Create);
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Level := 1;
if FileExists('in.cs') then
begin
old := TFileStream.Create('in.cs', fmOpenRead);
old.Read(len, 4);
for i:=0 to len-1 do
begin
old.Read(sz, 4);
old.Read(sz, 4);
old.Read(Letter, sz);
yang := TFileStream.Create('rich.tmp', fmCreate);
yang.CopyFrom(old, Letter.Sz);
yang.Free;
OutLine1.AddChildObject(pos, DateTimeToStr(Letter.Date) + ' ' + Letter.From + ' (' + Letter.Theme +')', TPost.Create);
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Level := 2;
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Letter := Letter;
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).Body.LoadFromFile('rich.tmp');
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).typ := true;
(TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).num := i;
DeleteFile('rich.tmp');
end;
old.Free;
OutLine1.FullExpand;
end;
end;

//просматриваем архив
procedure TClient.OutLine1Click(Sender: TObject);
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
if (TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).Level = 2 then
begin
BitBtn8.Enabled := true;
Panel1.Visible := true;
(TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).Body.SaveToFile('rich.tmp');
RichEdit1.Lines.Clear;
RichEdit1.Lines.LoadFromFile('rich.tmp');
DeleteFile('rich.tmp');
if (TPost(OutLine1.Lines.Objects[OutLine1.Lines.Count-1])).typ = true then
begin
LabeledEdit3.Text := (TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).Letter.From;
LabeledEdit3.EditLabel.Caption := 'От кого:';
end
else
begin
LabeledEdit3.Text := (TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).Letter.Name;
LabeledEdit3.EditLabel.Caption := 'Кому:';
end;
LabeledEdit4.Text := (TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).Letter.Theme;
end
else
begin
BitBtn8.Enabled := false;
end;
end;

//подгон размеров
procedure TClient.FormResize(Sender: TObject);
begin
OutLine1.Width := ClientWidth - OutLine1.Left - 2;
LabeledEdit4.Width := Panel1.ClientWidth - LabeledEdit4.Left - 2;
Panel1.Height := ClientHeight - OutLine1.Top - OutLine1.Height - 2;
RichEdit1.Height := Panel1.ClientHeight - LabeledEdit3.Top - LabeledEdit3.Height - 2;
end;

//открываем адресную книгу
procedure TClient.BitBtn6Click(Sender: TObject);
begin
AdrBook := TAdrBook.Create(Application);
AdrBook.Show;
BitBtn6.Enabled := false;
end;

//сохраняем ихменения после удаления письма
procedure TClient.DeleteLetter(ind : integer; inbox : boolean);
var yang, old : TFileStream;
nm : string;
sz, len, i : integer;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
if inbox = false then
begin
nm := 'out.cs';
end
else
begin
nm := 'in.cs';
end;
if FileExists(nm) then
begin
old := TFileStream.Create(nm, fmOpenRead);
yang := TFileStream.Create('tmp.tmp', fmCreate);
old.Read(sz, 4);
len := sz;
sz := sz - 1;
if sz = 0 then
begin
old.Free;
yang.Free;
DeleteFile('tmp.tmp');
DeleteFile(nm);
exit;
end;
yang.Write(sz, 4);
for i:=0 to len-1 do
begin
old.Read(sz, 4);
if i = ind then
begin
old.Seek(sz, soFromCurrent);
end
else
begin
yang.Write(sz, 4);
yang.CopyFrom(old, sz);
end;
end;
yang.Free;
old.Free;
if FileExists('tmp.tmp') then
begin
CopyFile('tmp.tmp', PChar(nm), False);
DeleteFile('tmp.tmp');
end;
end;
end;

//удалям письмо
procedure TClient.BitBtn8Click(Sender: TObject);
begin
DeleteLetter((TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).num, (TPost(OutLine1.Lines.Objects[OutLine1.SelectedItem-1])).typ);
OpenPost;
BitBtn7.Enabled := false;
BitBtn8.Enabled := false;
Panel1.Visible := false;
end;

//удаляем ненужные файлы
procedure TClient.FndandDelFile;
var sr : TSearchRec;
done : integer;
tmp : String;
begin
if DirectoryExists(ExtractFilePath(Application.ExeName) + login + '\') then
begin
SetCurrentDir(ExtractFilePath(Application.ExeName) + login + '\');
tmp := '*.*';
done := FindFirst(tmp, faAnyFile, sr);
while done = 0 do
begin
if ExtractFileExt(sr.Name) = '.snd' then
DeleteFile(sr.Name);
done := FindNext(sr);
end;
FindClose(sr);
end;
end;

end.





unit Unit2;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Unit1, Unit3, mesage;

type
TAuthorisation = class(TForm)
LabeledEdit3: TLabeledEdit;
LabeledEdit4: TLabeledEdit;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure LabeledEdit3KeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }

public
{ Public declarations }
key : String;
end;

var
Authorisation: TAuthorisation;
const
Digit: Set of Char = ['0' .. '9'];
LetLrg: Set of Char = ['A' .. 'Z'];
LetLtl: Set of Char = ['a' .. 'z'];

implementation

{$R *.dfm}

procedure TAuthorisation.BitBtn3Click(Sender: TObject);
begin
Close;
end;
//пытаемся войти или зарегистрироваться
procedure TAuthorisation.BitBtn2Click(Sender: TObject);
var mes : TMesage;
begin
if Client.ClientSocket1.Active then
begin
mes := TMesage.Create;
if Tag = 1 then
begin
mes.mesage := M_REG; //регистрация
end
else
begin
mes.mesage := M_ENT; //вход
end;
mes.AddToMessage(LabeledEdit3.Text, true);
mes.AddToMessage(LabeledEdit4.Text, true);
mes.AddToMessage(key, false);
Client.ClientSocket1.Socket.SendText(mes.mesage);
mes.Free;
end;
end;

procedure TAuthorisation.FormActivate(Sender: TObject);
begin
if Tag = 1 then BitBtn2.Caption := 'Зарегистрироваться';
end;
//конструктор формы
procedure TAuthorisation.FormCreate(Sender: TObject);
begin
Client.r_i := true;
key := IntToStr(Client.GetKey);
end;
//закрываем форму
procedure TAuthorisation.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Client.r_i := false;
end;
//проверяем при вводе символы: должны быть только цыфры и буквы латинского алфавита
procedure TAuthorisation.LabeledEdit3KeyPress(Sender: TObject; var Key: Char);
begin
if not (Key in Digit) and not (Key in LetLrg) and not (Key in LetLtl) and not (Key = #8) then
Key:=#0;
end;

end.





unit Unit3;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Unit1, StdCtrls, Buttons, ExtCtrls, Grids;

type

sAdr = record
Login, Name, Surname : String[32];
Comment : String[255];
end;

TAdrBook = class(TForm)
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
StringGrid1: TStringGrid;
Panel1: TPanel;
procedure BitBtn4Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure StringGrid1SetEditText(Sender: TObject; ACol, ARow: Integer;
const Value: String);
procedure BitBtn3Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
procedure SaveAdr;
procedure OpenAdr;
public
{ Public declarations }
end;

var
AdrBook: TAdrBook;

implementation

{$R *.dfm}
//кнопка "Закрыть"
procedure TAdrBook.BitBtn4Click(Sender: TObject);
begin
Close;
end;
//конструктор формы
procedure TAdrBook.FormCreate(Sender: TObject);
begin
StringGrid1.Cells[0,0] := 'Логин';
StringGrid1.Cells[1,0] := 'Имя';
StringGrid1.Cells[2,0] := 'Фамилия';
StringGrid1.Cells[3,0] := 'Примечание';
OpenAdr;
end;
//сохраняе адресную книгу
procedure TAdrBook.SaveAdr;
var name : TFileStream;
sz, i, len : integer;
adr : sAdr;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + Client.login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + Client.login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + Client.login + '\');
if FileExists('adr.cs') then
begin
DeleteFile('adr.cs');
end
else
begin
name := TFileStream.Create('adr.cs', fmCreate);
end;
len := StringGrid1.RowCount - 2;
name.Write(len, 4);
for i:=1 to len do
begin
adr.Login := StringGrid1.Cells[0,i];
adr.Name := StringGrid1.Cells[1,i];
adr.Surname := StringGrid1.Cells[2,i];
adr.Comment := StringGrid1.Cells[3,i];
sz := sizeof(adr);
name.Write(sz, 4);
name.Write(adr, sz);
end;
name.Free;
if FileExists('tmp.tmp') then
begin
CopyFile('tmp.tmp', 'adr.cs', False);
DeleteFile('tmp.tmp');
end;
end;
//открываем адресную книгу
procedure TAdrBook.OpenAdr;
var name : TFileStream;
sz, i, len : integer;
adr : sAdr;
begin
if not DirectoryExists(ExtractFilePath(Application.ExeName) + Client.login + '\') then
CreateDir(ExtractFilePath(Application.ExeName) + Client.login + '\');
SetCurrentDir(ExtractFilePath(Application.ExeName) + Client.login + '\');
if FileExists('adr.cs') then
begin
name := TFileStream.Create('adr.cs', fmOpenRead);
len := StringGrid1.RowCount - 2;
name.Read(len, 4);
StringGrid1.RowCount := len + 2;
for i:=1 to len do
begin
name.Read(sz, 4);
name.Read(adr, sz);
StringGrid1.Cells[0,i] := adr.Login ;
StringGrid1.Cells[1,i] := adr.Name;
StringGrid1.Cells[2,i] := adr.Surname;
StringGrid1.Cells[3,i] := adr.Comment;
end;
name.Free;
end;
end;
//кнопк "Сохранить"
procedure TAdrBook.BitBtn1Click(Sender: TObject);
begin
SaveAdr;
end;
//добавление новой строки в книге
procedure TAdrBook.StringGrid1SetEditText(Sender: TObject; ACol,
ARow: Integer; const Value: String);
begin
if ARow = StringGrid1.RowCount - 1 then StringGrid1.RowCount := StringGrid1.RowCount + 1;
end;

//вставляем адресата в поле "Кому:"
procedure TAdrBook.BitBtn3Click(Sender: TObject);
begin
Client.LabeledEdit3.Text := StringGrid1.Cells[0,StringGrid1.Row];
end;
//удаляем запись в адресной книге
procedure TAdrBook.BitBtn2Click(Sender: TObject);
var i, j : integer;
begin
if StringGrid1.Row <> StringGrid1.RowCount -1 then
begin
for i:=StringGrid1.Row to StringGrid1.RowCount - 2 do
begin
for j:=0 to StringGrid1.ColCount - 1 do
begin
StringGrid1.Cells[j,i] := StringGrid1.Cells[j,i+1];
end;
end;
StringGrid1.RowCount := StringGrid1.RowCount - 1;
end;
end;
//закрываем адресную книгу
procedure TAdrBook.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Client.BitBtn6.Enabled := true;
end;

end.





unit mesage;

interface

const
//неизвестный идентификатор
R_ERR = -1;
//ошибки входа/регистрации
M_BAD = '#M';
R_BAD = 0;
//успешный вход
M_ENT = '#E';
R_ENT = 1;
//авторизация пользователя
M_AUT = '#A';
R_AUT = 2;
//проверка существования пользователя
M_USR = '#U';
R_USR = 3;
//подтверждение отправки письма
M_YES = '#Y';
R_YES = 4;
//отправка письма
M_SND = '#S';
R_SND = 5;
//проверка сообщений в оффлайне
M_OFF = '#X';
R_OFF = 6;
//проверка ID клиента
M_UID = '#Z';
R_UID = 7;
//завершение отправки письма
M_FIN = '#F';
R_FIN = 8;
//регистрация нового пользователя
M_REG = '#R';
R_REG = 9;
type

TMesage = class //класс для обработки сообщений
public
mesage : String; //само сообщение
function TypeMessage() : integer;
function NextMessage(size : boolean) : String;
procedure AddToMessage(str: string; size : boolean);
end;
implementation


//определяем тип сообщения
function TMesage.TypeMessage() : integer;
var str : string;
begin
str := Copy(mesage, 1, 2);
Delete(mesage, 1, 2);
Result := R_ERR;
if str = M_BAD then
begin
Result := R_BAD;
end
else
begin
if str = M_ENT then
begin
Result := R_ENT;
end
else
begin
if str = M_AUT then
begin
Result := R_AUT;
end
else
begin
if str = M_USR then
begin
Result := R_USR;
end
else
begin
if str = M_YES then
begin
Result := R_YES;
end
else
begin
if str = M_SND then
begin
Result := R_SND;
end
else
begin
if str = M_OFF then
begin
Result := R_OFF;
end
else
begin
if str = M_UID then
begin
Result := R_UID;
end
else
begin
if str = M_FIN then
begin
Result := R_FIN;
end
else
begin
if str = M_REG then Result := R_REG;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;

function TMesage.NextMessage(size : boolean) : String;
var buf : char;
len : BYTE;
begin
if size = true then
begin //узнаем параметр с учетом его размера в количестве символов
buf := mesage[1];
len := BYTE(buf);
Delete(mesage, 1, 1);
Result := Copy(mesage, 1, len);
Delete(mesage, 1, len);
end
else
begin //безразмерный параметр
Result := mesage;
end;
end;

procedure TMesage.AddToMessage(str: string; size : boolean);
var buf : char;
len : BYTE;
begin
if size = true then
begin //добавляем параметр к сообщению с учетом его размера в количестве символов
len := Length(str);
buf := char(len);
mesage := mesage + buf + str;
end
else
begin //безразмерный параметр
mesage := mesage + str;
end;
end;

end.



Опубликовал Kest Июнь 17 2013 00:34:14 · 0 Комментариев · 4100 Прочтений · Для печати

• Не нашли ответ на свой вопрос? Тогда задайте вопрос в комментариях или на форуме! •


Комментарии
Нет комментариев.
Добавить комментарий
Имя:



smiley smiley smiley smiley smiley smiley smiley smiley smiley
Запретить смайлики в комментариях

Введите проверочный код:* =
Рейтинги
Рейтинг доступен только для пользователей.

Пожалуйста, залогиньтесь или зарегистрируйтесь для голосования.

Нет данных для оценки.
Гость
Имя

Пароль



Вы не зарегистрированны?
Нажмите здесь для регистрации.

Забыли пароль?
Запросите новый здесь.
Поделиться ссылкой
Фолловь меня в Твиттере! • Смотрите канал о путешествияхКак приготовить мидии в тайланде?
Загрузки
Новые загрузки
iChat v.7.0 Final...
iComm v.6.1 - выв...
Visual Studio 200...
CodeGear RAD Stud...
Шаблон для новост...

Случайные загрузки
Формирование отче...
Учебник для продв...
Запрет гостям ск...
Усложнённый кальк...
Редактор текста (...
C# Учебный курс
Факториал [Исходн...
Globus VCL Extent...
ЯЗЫК ПРОГРАММИРОВ...
AlnComponents
Модифицированная ...
Delphi World 6.0
ComboBox97
Киллер окон
AUTOWEB
ATComponents
Программирование ...
Электронный магаз...
Библиотека програ...
Реализация ЭЦП по...

Топ загрузок
Приложение Клие... 100530
Delphi 7 Enterp... 91894
Converter AMR<-... 20101
GPSS World Stud... 15392
Borland C++Buil... 13057
Borland Delphi ... 9153
Turbo Pascal fo... 7112
Калькулятор [Ис... 5193
Visual Studio 2... 5034
FreeSMS v1.3.1 3559
Случайные статьи
6.5. Дополнительна...
Фантомные файлы. 2
Окно свойств объек...
Определение параме...
Character expressi...
Установка переключ...
Инициализация глоб...
Информация о дизай...
Класс GestureDetec...
или общественной
Площадь треугольника
Как попробовать се...
Диагностика пробле...
Тестирование приме...
Очереди с приорите...
Предварительная об...
Списки
Фильтрация таблиц ...
Активизация некот...
Измерение объемов ...
Windows XP Profess...
Упорядоченный дина...
Основы указателей
Числовые системы в...
SDECREMENT (УМЕНЬШ...
Статистика



Друзья сайта
Программы, игры


Полезно
В какую объединенную сеть входит классовая сеть? Суммирование маршрутов Занимают ли таблицы память маршрутизатора?