Рассылка закрыта
При закрытии подписчики были переданы в рассылку "Программирование в Delphi" на которую и рекомендуем вам подписаться.
Вы можете найти рассылки сходной тематики в Каталоге рассылок.
СообЧА. Программирование на Delphi
<xHEAD> <xTITLE>Subscribe.Ru :СообЧа программирование на дельфи !<x/TITLE> <xMETA NAME="keywords" CONTENT="delphi vcl programming статьи исходники компоненты compoents сометы дельфи"> <xMETA NAME="author" CONTENT="i@cooler.com.ua Ведущий рассылки: Залуский Антон COOLer"> <x/HEAD> <xBODY BGCOLOR=#FFCC66 LINK=#660000 ALINK=#000000 VLINK=#000000 TEXT=#000000> <div align="center"><font size="+3"><xhtml> <xhead> <xmeta http-equiv="Content-Language" content="ru"> <xmeta http-equiv="Content-Type" content="text/html; charset=windows-1251"> <xmeta name="GENERATOR" content="Microsoft FrontPage 4.0"> <xmeta name="ProgId" content="FrontPage.Editor.Document"> <xtitle><u><font size="+1" font color ="#73493C" face="Courier New, Courier, mono"><b>™</b></font></u><font color="#73493C"><b><font size="+1" face="Courier New, Courier, mono"><xbody bgcolor="#C0C0C0"></font><font size="+1" font="undefined" face="Courier New, Courier, mono"><u>—Сообча<x/title> : программирование на дельфи<x/head> —</u></font></b></font><b><font size="+1" face="Courier New, Courier, mono"> </font></b></font></div> <div align="center"><font size="+1" face="Courier New, Courier, mono"><b> </b></font></div> <hr> <center> <table border=0 cellpadding=0 cellspacing=0 width=80%> <tr> <td align=center> <table border=1 cellpadding=0 cellspacing=0 width="331"> <tr> <td height="111"> <table border=0 cellpadding=3 cellspacing=0 width="325"> <tr> <td align="left" valign="top" bgcolor="#FFCC66" height="125"> <p align="center"><b><font color="#000000">Некому оформить сайт ?<br> Нужен красивый баннер ?<br> Нет времени на обновление сайта?</font></b></p> <p align="center"><marquee>Качественное оформление, работа с самыми современными средствами, FLASH,CGI,JAVA</marquee> <br> <a href="mailto:pixel@novgorod.net"><b>Тогда вам сюда !!!! </b></a><br> <b>За 50$-100$ мы поможем</b> </td> </tr> </table> </td> </tr> </table> </td> </tr> </table> </center> <HR NOSHADE> <table border="0" width="97%" align="center"> <tr> <td width="100%" bgcolor="#F9BC4D"> <div align="center"> <table border="0" width="93%" height="354" cellspacing="0" cellpadding="0" align="center" bgcolor="#999999"> <center> <tr> <td width="48%" height="19" bgcolor="#993300"><b><font color="#000000">----- (перед просмотром рассылку лучше сохранить)</font></b></td> <td width="52%" height="19" bgcolor="#993300"> <div align="center"><u><b><a href="Mailto:Pixel@novgorod.net"><font color="#000000">Design:Pixel</font></a></b></u></div> </td> </tr> </center> <tr> <center> <td width="48%" height="190" bgcolor="#FFCC66" valign="top" align="left"> <p> </p> <p><b><u><a name="main"> В этом выпуске:</a></u></b> </p> <ul> <li><b><u><a href="#Дехшояйбмяс">Кодируем файл</a></u></b></li> <li><b><u><a href="#Лмкгнесыяс губййем">FTP Сервер </a></u></b></li> <li><b><u><a href="http://www.ozon.ru/index.cfm/partner=delphibos">;Книжки и CD(читать иногда полезно, а можно и поиграться!)</a></u></b></li> </ul> </td> </center> <td width="52%" height="190" bgcolor="#FFCC66"> <center> <p align="left"><b><font color="#000099">Фонд поддержки наших проектов и рассылки</font>:</b><br> <b><font color="#660000" size="2">Получатель</font></b>: ИНН 7707083893 Новгородское ОСБ № 8629<br> <b><font size="2" color="#660000">Счет получателя</font>: </b>47422810343029900030<b><br> <font size="2" color="#660000">Банк получателя</font></b><font size="2" color="#FF0000"> </font>:Новгородское ОСБ № 8629 г.Великий Новгород 30101810100000000698<br> <b>Бик</b> 044959698<br> </p> <table bgcolor="#000000" width="373"> <tbody> <tr> <td align="middle" bgColor="#993300"><font size="-1">Рассылки <a href="http://subscribe.ru/"><b>Subscribe.Ru</b></a><b>; это стильно удобно, и информативно!</b></font></td> </tr> <tr> <td vAlign="center" align="left" bgColor="#FFCC66" height="61"><font size="-1"> <input type="checkbox" CHECKED value="comp.soft.prog.soobcha" name="grp"> СообЧа (СООБщество ЧАйников). Обмен опытом, вопросы, ответы.<br> </font></td> </tr> <tr> <td vAlign="center" align="middle" bgColor="#FFCC66" height="9"> <p><font size="-1"> <input type="text" style=""FONT-SIZE:" 9pt" name="email" maxlen="100" size="20" value="Ваш e-mail"> <input style=""FONT-SIZE:" 9pt" type="submit" value="OK"> <br> </font><font size="-2"><b>подпишись и подпиши друга!!!!</b></font></p> </td> </tr> </tbody> </table> <p> Contact (Связь с Нами): <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0"><a href="mailto:Pixel@novgorod.net">Pixel@novgorod.net</a> + <i><b>Subject:</b></i> (см ниже) </center> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"><b><font size="1">Vcl Haunting</font></b> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"><font size="1"><b>"Золотой Чайник"</b> </font> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"><font size="1"><b>Вопрос по дельфи N (N номер версии)</b> </font> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"><font size="1"><b>Help!</b> </font> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"><font size="1"><b>Реклама</b></font> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0" align="left"><font size="1"><b>Полезный линк</b></font> <center> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0"> <p style=""text-indent:" 0; word-spacing: 0; line-height: 100%; margin: 0"><b><font color="#FF6633">Наш сайт :</font> <a href="http://pixelsoft.narod.ru">pixelsoft.narod.ru</a></b>; </center> </td> </tr> <tr> <td colspan="2" height="2"> </td> </tr> </table> </div> <table border="0" width="93%" cellpadding="2" align="center" height="531"> <tr> <td width="60%" bgcolor="#FF9900" height="29"> <p align="center"><font size="4"><b>Новости СЕТИ</b></font> </td> <td width="40%" bgcolor="#FFCC66" height="29"> <p align="right"><font color="#FFFFFF"><a href="#main"><b>К заголовку</b></a></font> </td> </tr> <tr valign="top" align="left" bgcolor="#FFCC66" bordercolor="#FF0000"> <td colspan="2" height="490"> <p align="left"><b>Книги по Дельфи которые ВЫ ОБЯЗАНЫ ПРОЧИТАТЬ...</b></p> <ul> <li><a href="http://www.ozon.ru/detail.cfm/ent=2&id=52724&partner=delphibos%20"><b>Б</b></a><a href="http://www.ozon.ru/detail.cfm/ent=2&id=52724&partner=delphibos%20"><b>;азы данных и приложения в дельфи 6 </b></a>, спешите купить</li> <li><b><a href="http://www.ozon.ru/detail.cfm/ent=2&id=53040&partner=delphibos%20">Delphi 6 : Наиболее полное руководство</a></b></li> </ul> <p align="left">Не столько учебник, сколько справочное пособие по наиболее используемым алгоритмам и командам...</p> <ul> <li><b><a href="http://www.ozon.ru/detail.cfm/ent=2&id=54781&partner=delphibos%20">;Дельфи 6: Учебный курс</a></b></li> </ul> <p align="left">Пожалуй лучший учебник по дельфи 6 на сегодняшний день, вам даже не надо знать дельфи, чтобы начать ...</p> <ul> <li><b><a href="http://www.ozon.ru/detail.cfm/ent=2&id=19143&partner=delphibos%20">;Дельфи 5: Руководство разработчика БД</a></b></li> <p> </p> <p><a href="http://www.ozon.ru/detail.cfm/ent=2&id=51691&partner=delphibos%20"><b>DirectX. Графика в проектах Delphi (+CD - ROM)</b></a><br> Лучшее пособие для тех кто решил связаться с DirectX, по слухам на CD помимо примеров есть DirectxSDK7.0 от Microsoft...</p> <p><a href="http://www.ozon.ru/detail.cfm/ent=2&id=44505&partner=delphibos%20"><b>;Среда программирования Delphi 5-6. Справочное пособие</b></a><br> Книга полностью описывает среду программирования Delphi, которая включает в себя полный набор визуальных инструментов для быстрой и профессиональной разработки приложений для различных операционных систем, кроме того рассмотрены проблемы перехода между этими версиями дельфи.</p> <p> <b><font color="#FF0000"><a href="http://www.ozon.ru/detail.cfm/ent=2&id=55868&partner=delphibos%20">;Программирование в Delphi 6 (+ floppy дискета )</a> Чайникам рекомендуется!!!</font></b></p> <p>Книга содержит методические и справочные материалы по новой версии системы визуального объектно-ориентированного программирования Delphi 6 и предшествующим версиям Delphi 5 и 4. Рассмотрены такие новые возможности Delphi, как кросс-платформенные приложения, технологии доступа к данным ADO, InterBase Express, dbExpress, компоненты — серверы СОМ, технологии распределенных приложений СОМ, CORBA, MIDAS, новая методика диспетчеризации действий... </p> </ul> </td> </tr> </table> <p> </p> <table border="0" width="93%" cellpadding="2" cellspacing="0" align="center"> <tr> <td width="60%" bgcolor="#FF9900" valign="top"> <p align="center"><a name="Дехшояйбмяс"><b><font color="#000000">Кодируем файл... </font></b></a> </td> <td width="40%" bgcolor="#FFCC66"> <p align="right"><font color="#FFFFFF"><a href="#main"><b>К заголовку</b></a></font> </td> </tr> <tr valign="top" align="left" bgcolor="#FFCC66"> <td colspan="2"> <p>Скоро присвою себе название Research Lab , ей богу :)... Каждый день сижу и пытаюсь придумать что-нибудь необычное .<br> Вот эта штука может кодировать файлы, при том довольно сносно. Скорость конечно желает лучшего 300-400 кб в сек (в зависимости от винта и проца). Для избежания геммороя я ипользовал ассемблер и сделал инвертирование битов со сдвигом на 3. Кодированный файл , для верности можно еще и поделить на два, тогда информацию будет трудно разшифровать(при условии что половина файла будет бесполезна, а другая кодированна другим алгоритмом).</p> <p>unit Unit2;</p> <p>interface</p> <p>uses windows,classes;<br> function code(FileName,outfile : string) : DWORD;<br> function decode(FileName,outfile : string) : DWORD;<br> implementation<br> uses unit1;</p> <p></p> <p><br> function code(FileName,outfile : string) : DWORD;<br> var<br> f,d1: file;<br> buf:dword;<br> ready:longint;<br> begin<br> // GetMem(buf,16384);<br> FileMode := 2;<br> assignfile(f,filename);<br> assignfile(d1,outfile);<br> reset(f,1) ;<br> rewrite(d1,1);<br> seek(f,0);<br> repeat<br> blockread(f,buf,1,ready);<br> asm<br> mov eax,buf<br> sub eax,3<br> not eax<br> mov buf,eax<br> end;<br> blockwrite(d1,buf,ready);<br> until ready=0;<br> closefile(d1);<br> closefile(f);</p> <p> end;</p> <p>/////////////<br> function decode(FileName,outfile : string) : DWORD;<br> var<br> f,d1: file;<br> buf:dword;<br> ready:longint;</p> <p>begin</p> <p>// GetMem(buf,16384);<br> FileMode := 2;<br> assignfile(f,filename);<br> assignfile(d1,outfile);<br> reset(f,1) ;<br> rewrite(d1,1);<br> seek(f,0);<br> repeat<br> blockread(f,buf,1,ready);<br> asm<br> mov eax,buf<br> not eax<br> add eax,3<br> mov buf,eax<br> end;<br> blockwrite(d1,buf,ready);<br> until ready=0;<br> closefile(d1);<br> closefile(f);<br> </p> <p>end;</p> <p>end.<br> <br> Собственно код получился небольшой и весьма оптимизированный.</p> </td> </tr> </table> <p style=""word-spacing:" 0; line-height: 100%; margin-top: 0; margin-bottom: 0"> </p> <p style=""word-spacing:" 0; line-height: 100%; margin-top: 0; margin-bottom: 0"> </p> <table border="0" width="93%" cellpadding="2" align="center"> <tr> <td width="60%" bgcolor="#FF9900" height="2"> <p align="center"><font size="4" color="#000000"><b><a name="Лмкгнесыяс губййем">FTP сервер </a></b></font> </td> <td width="40%" bgcolor="#FFCC66" height="2"> <p align="right"><font color="#FFFFFF"><a href="#main"><b>К заголовку</b></a></font> </td> </tr> <tr valign="top" align="left" bgcolor="#FFCC66"> <td width="100%" colspan="2"> <p>кусочек кода(98% , вырезан Aboutbox) программы SmallFTP server</p> <p>unit Main;</p> <p>interface</p> <p>uses<br> Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,<br> StdCtrls, ComCtrls, ImgList, ToolWin, Menus, Buttons, FtpSrv,FtpSrvC,<br> Spin,FileCtrl, ExtCtrls,Winsock;</p> <p>type<br> TfrmMain = class(TForm)<br> StatusBar1: TStatusBar;<br> ImageList1: TImageList;<br> PageControl1: TPageControl;<br> TabSheet1: TTabSheet;<br> TabSheet2: TTabSheet;<br> ListView1: TListView;<br> RichEdit1: TRichEdit;<br> MainMenu1: TMainMenu;<br> PopupMenu1: TPopupMenu;<br> TabSheet3: TTabSheet;<br> TabSheet4: TTabSheet;<br> FtpServer1: TFtpServer;<br> Label4: TLabel;<br> txtBanner: TEdit;<br> SpinEdit1: TSpinEdit;<br> Label5: TLabel;<br> ImageList2: TImageList;<br> File1: TMenuItem;<br> StartFTP1: TMenuItem;<br> StopFTP1: TMenuItem;<br> N1: TMenuItem;<br> Exit1: TMenuItem;<br> Users1: TMenuItem;<br> Help1: TMenuItem;<br> About1: TMenuItem;<br> N2: TMenuItem;<br> Help2: TMenuItem;<br> BootUser2: TMenuItem;<br> ImageList3: TImageList;<br> ToolBar2: TToolBar;<br> ListView2: TListView;<br> ImageList4: TImageList;<br> ToolButton10: TToolButton;<br> ToolButton12: TToolButton;<br> ToolButton13: TToolButton;<br> ToolButton14: TToolButton;<br> Panel1: TPanel;<br> Label1: TLabel;<br> txtUser: TEdit;<br> Label2: TLabel;<br> txtPassword: TEdit;<br> Label3: TLabel;<br> txtRoot: TEdit;<br> BitBtn1: TBitBtn;<br> chkDelete: TCheckBox;<br> chkRename: TCheckBox;<br> chkDownload: TCheckBox;<br> chkUpload: TCheckBox;<br> Panel2: TPanel;<br> Timer1: TTimer;<br> BitBtn2: TBitBtn;<br> BitBtn3: TBitBtn;<br> ToolButton8: TToolButton;<br> ToolButton9: TToolButton;<br> BitBtn4: TBitBtn;<br> SpinEdit2: TSpinEdit;<br> Label6: TLabel;<br> ToolBar1: TToolBar;<br> ToolButton1: TToolButton;<br> ToolButton2: TToolButton;<br> ToolButton5: TToolButton;<br> ToolButton4: TToolButton;<br> ToolBar3: TToolBar;<br> ImageList5: TImageList;<br> ToolButton6: TToolButton;<br> ToolButton7: TToolButton;<br> SaveDialog1: TSaveDialog;<br> TheServer1: TMenuItem;<br> ActivityLog1: TMenuItem;<br> AllowedUsers1: TMenuItem;<br> ExtraOptions1: TMenuItem;<br> procedure ToolButton1Click(Sender: TObject);<br> procedure FtpServer1ChangeDirectory(Sender: TObject;<br> Client: TFtpCtrlSocket; Directory: TFtpString; var Allowed: Boolean);<br> procedure FtpServer1Authenticate(Sender: TObject;<br> Client: TFtpCtrlSocket; UserName, Password: TFtpString;<br> var Authenticated: Boolean);<br> procedure FtpServer1ValidateDele(Sender: TObject;<br> Client: TFtpCtrlSocket; var FilePath: TFtpString;<br> var Allowed: Boolean);<br> procedure FtpServer1ValidateGet(Sender: TObject;<br> Client: TFtpCtrlSocket; var FilePath: TFtpString;<br> var Allowed: Boolean);<br> procedure FtpServer1ValidatePut(Sender: TObject;<br> Client: TFtpCtrlSocket; var FilePath: TFtpString;<br> var Allowed: Boolean);<br> procedure FtpServer1ClientConnect(Sender: TObject;<br> Client: TFtpCtrlSocket; Error: Word);<br> procedure FtpServer1ClientDisconnect(Sender: TObject;<br> Client: TFtpCtrlSocket; Error: Word);<br> procedure FtpServer1ClientCommand(Sender: TObject;<br> Client: TFtpCtrlSocket; var Keyword, Params, Answer: TFtpString);<br> procedure FtpServer1Stop(Sender: TObject);<br> procedure FtpServer1Start(Sender: TObject);<br> procedure ToolButton2Click(Sender: TObject);<br> procedure FormClose(Sender: TObject; var Action: TCloseAction);<br> procedure ToolButton7Click(Sender: TObject);<br> function AddClient(sUser : String; sAction : String; sDir : String) : boolean;<br> procedure ModifyClient(sUser : String; sAction : String; sDir : String);<br> procedure RemoveClient(sUser : String);<br> function isClientThere(sUser : string): Boolean;<br> function isClient(sUser : String; sPass : String;Client: TFtpCtrlSocket): string;<br> procedure getClientpermissions(sUser : String);<br> procedure FormCreate(Sender: TObject);<br> procedure ToolButton4Click(Sender: TObject);<br> procedure TabSheet3Exit(Sender: TObject);<br> procedure TabSheet3Enter(Sender: TObject);<br> function getClientRootDir(sUser : string): String;<br> procedure Timer1Timer(Sender: TObject);<br> procedure BitBtn2Click(Sender: TObject);<br> procedure BitBtn3Click(Sender: TObject);<br> procedure ToolButton10Click(Sender: TObject);<br> procedure ToolButton13Click(Sender: TObject);<br> procedure ToolButton14Click(Sender: TObject);<br> procedure LoadUserList;<br> procedure SaveUserList;<br> procedure ListView2SelectItem(Sender: TObject; Item: TListItem;<br> Selected: Boolean);<br> procedure EditClient;<br> procedure BitBtn1Click(Sender: TObject);<br> procedure BitBtn4Click(Sender: TObject);<br> procedure ListView2MouseUp(Sender: TObject; Button: TMouseButton;<br> Shift: TShiftState; X, Y: Integer);<br> procedure bSaveUserList;<br> procedure ToolButton9Click(Sender: TObject);<br> procedure ToolButton6Click(Sender: TObject);<br> procedure TheServer1Click(Sender: TObject);<br> procedure ActivityLog1Click(Sender: TObject);<br> procedure AllowedUsers1Click(Sender: TObject);<br> procedure ExtraOptions1Click(Sender: TObject);<br> function IsAllowedTo(sUser : String; IAction : Integer) : Boolean;<br> procedure Help2Click(Sender: TObject);<br> procedure About1Click(Sender: TObject);<br> procedure Exit1Click(Sender: TObject);<br> private<br> { Private declarations }<br> public<br> { Public declarations }<br> end;</p> <p>var<br> frmMain: TfrmMain;<br> bConnected: Boolean;<br> UserFile: String;<br> cliDir: String;<br> implementation</p> <p>uses NewUser, Dir, About;</p> <p>{$R *.DFM}<br> function GetLocalIP : string;<br> // <br> // Return computerґs IP if you are connected in a network<br> // Declare Winsock in the uses clause <br> // <br> type <br> TaPInAddr = array [0..10] of PInAddr; <br> PaPInAddr = ^TaPInAddr; <br> var <br> phe : PHostEnt; <br> pptr : PaPInAddr; <br> Buffer : array [0..63] of char; <br> I : Integer; <br> GInitData : TWSADATA; <br> begin <br> WSAStartup($101, GInitData); <br> Result := ''; <br> GetHostName(Buffer, SizeOf(Buffer)); <br> phe :=GetHostByName(buffer); <br> if phe = nil then <br> begin <br> Exit; <br> end; <br> pptr := PaPInAddr(Phe^.h_addr_list); <br> I := 0; <br> while pptr^[I] <> nil do <br> begin <br> result:=StrPas(inet_ntoa(pptr^[I]^)); <br> Inc(I); <br> end; <br> WSACleanup; <br> end; <br> function bMakeBoolean(sStr : String): Boolean;<br> begin<br> if lowercase(sstr) = 'no' then<br> begin<br> bMakeBoolean := false;<br> end<br> else<br> begin<br> bMakeBoolean := true;<br> end;</p> <p>end;</p> <p>function bMakeString(bBool : Boolean): String;<br> begin<br> if bbool = false then<br> begin<br> bMakeString := 'No'<br> end<br> else<br> begin<br> bMakeString := 'Yes';<br> end;</p> <p>end;</p> <p>procedure Logit(sTXT : String);<br> begin<br> try<br> frmMain.RichEdit1.Lines.Insert(0,DateTimeToStr(Now) + ' - ' + stxt);<br> except<br> frmMain.RichEdit1.Lines.Clear;<br> frmMain.RichEdit1.Lines.Insert(0,DateTimeToStr(Now) + ' - ' + stxt);<br> end;</p> <p><br> end;</p> <p>function AppPath: String ;<br> //get the path of this file<br> begin<br> AppPath := ExtractFilePath(application.ExeName);<br> end;<br> function FileDelete(sFile :String):Boolean ;<br> begin<br> if FileExists(sFile) = True then<br> FileDelete := DeleteFile(sfile)<br> else<br> FileDelete := False;<br> end;<br> function DirDel(sPath : String):Boolean ;<br> begin<br> if DirectoryExists(sPath) = True then<br> DirDel := RemoveDir(sPath)<br> else<br> dirdel := false;<br> end;<br> function FileORDirDel(sPath : String; sFile : String): Boolean;<br> begin<br> if StrLen(pChar(sfile)) >0 then<br> //it is a file<br> FileORDirDel := filedelete(spath + sfile)<br> else<br> //it is a dir<br> FileORDirDel := dirdel(spath);<br> end;<br> function FileORDirRNTO(sPath : String; sFile : String): Boolean;<br> Var<br> iPos : Integer;<br> begin<br> ipos := pos('.',sFile);<br> if ipos > 0 then<br> //it is a file - handled by ftp<br> FileORDirRNTO := True<br> else<br> // it is a directory - manual rename c:\test\ / 222<br> if DirectoryExists(sPath) = True then<br> begin<br> FileORDirRNTO := MoveFile(pchar(spath),pchar(sfile));<br> end<br> else<br> begin<br> FileORDirRNTO := false;<br> end;</p> <p></p> <p>end;<br> function CheckStartDir(sDir : String):Boolean ;<br> begin<br> //make sure it is a dir<br> if sdir = '' then<br> CheckStartDir := false;</p> <p> //it is a dir, check it<br> if sdir <> '' then<br> begin<br> CheckStartDir := DirectoryExists(sdir);<br> end;<br> end;</p> <p>procedure FTPStart;<br> begin<br> frmmain.FtpServer1.Start;<br> Logit('FTP Started');<br> end;</p> <p>procedure FTPStop;<br> begin<br> if bConnected = true then<br> begin<br> if MessageDlg('Warning stoping the FTP server will disconnect any clients!' + chr(10) + 'Are you sure you want to stop the FTP server?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then<br> begin<br> frmmain.FtpServer1.DisconnectAll;<br> frmmain.FtpServer1.Stop;<br> Logit('FTP Stopped');<br> end;<br> end;</p> <p>end;</p> <p>function GetLineEle(sTmp : String; Delimi1 : String; Delimi2 : String): String;<br> Var<br> Ipos :Integer;<br> Epos : Integer;<br> begin<br> try<br> ipos := pos(Delimi1,stmp);<br> if ipos = 0 then<br> begin<br> GetLineEle := '';<br> exit;<br> end;<br> epos := pos(Delimi2,stmp);<br> if epos = 0 then<br> begin<br> GetLineEle := '';<br> exit;<br> end;<br> ipos := ipos + Length(Delimi1);</p> <p>GetLineEle := copy(stmp,ipos ,epos - ipos);<br> except<br> GetLineEle := '';<br> end;<br> end;</p> <p>function QualifyDir(sDir : String):String ;<br> Var<br> Ipos :Integer;<br> TmpDir : String;<br> begin<br> ipos := StrLen(pchar(sdir));<br> tmpdir := copy(sdir,ipos,strlen(pchar(sdir)));<br> if tmpdir <> '\' then<br> QualifyDir := sdir + '\';<br> if tmpdir = '\' then<br> QualifyDir := sdir;<br> end;</p> <p>procedure TfrmMain.ToolButton1Click(Sender: TObject);<br> begin<br> ftpstart;<br> end;</p> <p>procedure TfrmMain.FtpServer1ChangeDirectory(Sender: TObject;<br> Client: TFtpCtrlSocket; Directory: TFtpString; var Allowed: Boolean);<br> begin<br> { It the right place to check if a user has access to a given directory }<br> { The example below disable C:\ access to non root user. }<br> //if (UpperCase(Client.UserName) <> 'ROOT') and<br> // (UpperCase(Client.Directory) = 'C:\') then<br> // Allowed := FALSE;</p> <p> if length(Client.Directory) < length(client.HomeDir) then begin<br> Allowed := FALSE;<br> exit;<br> end;<br> //logit(client.username + ' CD ' +<br> Allowed := TRUE;<br> end;</p> <p>procedure TfrmMain.FtpServer1Authenticate(Sender: TObject;<br> Client: TFtpCtrlSocket; UserName, Password: TFtpString;<br> var Authenticated: Boolean);<br> begin<br> //authorize client</p> <p><br> if isClientThere(UserName) = false then<br> begin<br> clidir := isClient(username,password,client);</p> <p> if clidir <> '' then<br> begin</p> <p> //add the client to the list<br> Authenticated := true;<br> client.HomeDir := clidir;<br> //client.FileName :='';<br> end;<br> end<br> else<br> begin</p> <p>//do not let them in multiple client error<br> Authenticated := false;<br> //client.Close;<br> end;<br> statusbar1.Panels[1].text := 'Number of Users: ' + inttostr(listview1.Items.count);<br> //Authenticated := True;<br> //client.HomeDir := 'd:\test\';<br> //client.FileName :='';<br> end;</p> <p>procedure TfrmMain.FtpServer1ValidateDele(Sender: TObject;<br> Client: TFtpCtrlSocket; var FilePath: TFtpString; var Allowed: Boolean);<br> begin<br> {<br> if CheckBox5.Checked = FALSE then begin<br> allowed := FALSE;<br> end;<br> }<br> end;</p> <p>procedure TfrmMain.FtpServer1ValidateGet(Sender: TObject;<br> Client: TFtpCtrlSocket; var FilePath: TFtpString; var Allowed: Boolean);<br> begin<br> {<br> if CheckBox5.Checked = FALSE then begin<br> allowed := FALSE;<br> end;<br> }<br> end;</p> <p>procedure TfrmMain.FtpServer1ValidatePut(Sender: TObject;<br> Client: TFtpCtrlSocket; var FilePath: TFtpString; var Allowed: Boolean);<br> begin<br> {<br> if CheckBox5.Checked = FALSE then begin<br> allowed := FALSE;<br> end;<br> }<br> end;</p> <p>procedure TfrmMain.FtpServer1ClientConnect(Sender: TObject;<br> Client: TFtpCtrlSocket; Error: Word);<br> begin<br> //do the connection here<br> Logit(client.UserName + ' - ' + client.DataSocket.Addr + ' Connected');<br> end;</p> <p>procedure TfrmMain.FtpServer1ClientDisconnect(Sender: TObject;<br> Client: TFtpCtrlSocket; Error: Word);<br> begin<br> //do the disconnection here<br> RemoveClient(client.UserName);<br> statusbar1.Panels[1].text := 'Number of Users: ' + inttostr(listview1.Items.count);<br> Logit(client.UserName + ' - ' + client.DataSocket.Addr + ' Disconnected');<br> end;</p> <p>procedure TfrmMain.FtpServer1ClientCommand(Sender: TObject;<br> Client: TFtpCtrlSocket; var Keyword, Params, Answer: TFtpString);<br> var<br> hGood : Boolean;<br> SFD1 : String;<br> SFD2 : String;<br> begin<br> hgood:=False;</p> <p>{<br> We are looking for the following commands<br> PUT - upload<br> STOR - Upload<br> GET - download<br> RETR - download<br> DELE - delete<br> RNFR - rename from</p> <p>}<br> ModifyClient(client.username,Keyword,client.directory);<br> Logit(client.UserName + ' - ' + client.DataSocket.Addr + ' ' + Keyword + ' ' + client.directory + params);<br> //DELE = delete<br> //if rename then begin<br> if (Keyword = 'PUT') or (Keyword = 'STOR') then<br> begin<br> if IsAllowedTo(client.username,2) = false then<br> begin<br> client.SendAnswer('501 - Not Allowed!');<br> exit;<br> end;<br> end;</p> <p>if (Keyword = 'GET') or (Keyword = 'RETR') then<br> begin<br> if IsAllowedTo(client.username,3) = false then<br> begin<br> client.SendAnswer('501 - Not Allowed!');<br> exit;<br> end;<br> end;</p> <p>//if rename then begin<br> //RNTO = rename from<br> if KeyWord ='RNFR' then<br> begin<br> if IsAllowedTo(client.username,4) = false then<br> begin<br> client.SendAnswer('501 - Not Allowed!');<br> exit;<br> end;<br> sfd1 := client.directory + params;</p> <p>end;<br> //RNTO = rename to<br> if Keyword = 'RNTO' then<br> begin<br> if IsAllowedTo(client.username,4) = false then<br> begin<br> client.SendAnswer('501 - Not Allowed!');<br> exit;<br> end;<br> sfd2 := client.directory + params;<br> hgood := FileORDirRNTO(sfd1,sfd2);<br> sfd1 := '';<br> sfd2 := '';<br> end;</p> <p>if Keyword = 'DELE' then<br> begin<br> if IsAllowedTo(client.username,5) = false then<br> begin<br> client.SendAnswer('501 - Not Allowed!');<br> exit;<br> end;<br> hgood := fileordirdel(client.Directory,params);<br> client.FileName :='';<br> client.Directory := '';<br> end;</p> <p>end;</p> <p>procedure TfrmMain.FtpServer1Stop(Sender: TObject);<br> begin<br> //ftp stop<br> toolbutton1.Enabled := true;<br> toolbutton2.Enabled := false;<br> startftp1.Enabled := true;<br> stopftp1.Enabled := false;<br> statusbar1.Panels[0].text := 'Ftp is OFF';<br> bConnected := false;<br> end;</p> <p>procedure TfrmMain.FtpServer1Start(Sender: TObject);<br> begin<br> //ftp start<br> toolbutton1.Enabled := false;<br> toolbutton2.Enabled := true;<br> startftp1.Enabled := false;<br> stopftp1.Enabled := true;<br> statusbar1.Panels[0].text := 'Ftp is ON';<br> bConnected := true;<br> end;</p> <p>procedure TfrmMain.ToolButton2Click(Sender: TObject);<br> begin<br> ftpstop;<br> end;</p> <p>procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);<br> begin<br> ftpstop;<br> end;</p> <p>procedure TfrmMain.ToolButton7Click(Sender: TObject);<br> begin<br> RichEdit1.Lines.Clear;<br> end;</p> <p>function TfrmMain.AddClient(sUser : String; sAction : String; sDir : String) : boolean;<br> begin<br> //add a new client to the list</p> <p>end;<br> procedure TfrmMain.ModifyClient(sUser : String; sAction : String; sDir : String);<br> Var<br> I : Integer;<br> ListItem: TListItem;<br> begin<br> //remove an existing client<br> for i := 0 to listview1.items.count -1 do<br> begin<br> if lowercase(suser) = lowercase(listview1.items[i].caption) then<br> begin<br> ListItem := listview1.Items[i];<br> listitem.SubItems[0] := saction;<br> listitem.SubItems[1] := sdir;<br> exit;<br> end;<br> end;<br> end;</p> <p>procedure TfrmMain.RemoveClient(sUser : String);<br> Var<br> I : Integer;<br> begin<br> //remove an existing client<br> for i := 0 to listview1.items.count -1 do<br> begin<br> if lowercase(suser) = lowercase(listview1.items[i].caption) then<br> begin<br> listview1.Items.Delete(i);<br> exit;<br> end;<br> end;</p> <p>end;<br> function TfrmMain.isClientThere(sUser : String): Boolean ;<br> Var<br> I : Integer;<br> bTMP : Boolean;<br> begin<br> // is the user there in our list<br> if ListView1.Items.Count = 0 then<br> begin<br> isClientThere := false;<br> exit;<br> end;<br> for I := 0 to ListView1.Items.Count -1 do<br> begin<br> //check the suser against the list item<br> if lowercase(suser) = lowercase(ListView1.Items[i].Caption) then<br> begin<br> isClientThere := true;<br> exit;<br> end;</p> <p>isClientThere := false;</p> <p>end;</p> <p>end;<br> procedure TfrmMain.getClientpermissions(sUser : String);<br> begin<br> //get the client permissions</p> <p>end;</p> <p>function TfrmMain.isClient(sUser : String; sPass : String; Client: TFtpCtrlSocket): string ;<br> var<br> F: TextFile;<br> S: string;<br> zUser: String;<br> zPass: String;<br> zDir: String;<br> ListItem: TListItem;</p> <p> begin<br> //is it a valid client<br> AssignFile(F, UserFile); { File selected in dialog box }<br> Reset(F);<br> while not EOF(F) do<br> begin<br> Readln(F, S); { Read the first line out of the file }<br> zUser := getlineele(s,'<user>','</user>');<br> zPass := getlineele(s,'<password>','</password>');<br> if (lowercase(zuser) = lowercase(suser)) and (lowercase(zpass) = lowercase(spass)) then<br> begin<br> //set the client permissions<br> zDir := getlineele(s,'<root>','</root>');<br> if directoryexists(zDir) = false then<br> begin<br> CloseFile(F);<br> isClient := '';<br> end;<br> CloseFile(F);<br> //add it to the list<br> listitem := ListView1.Items.Add;<br> listitem.Caption := suser; //username<br> listitem.SubItems.Add('Logged In'); //action<br> listitem.SubItems.Add(zdir); //location<br> listitem.SubItems.Add(getlineele(s,'<up>','</up>'));//upload<br> listitem.SubItems.Add(getlineele(s,'<down>','</down>'));//download<br> listitem.SubItems.Add(getlineele(s,'<rename>','</rename>'));//rename<br> listitem.SubItems.Add(getlineele(s,'<delete>','</delete>'));//delete<br> //return from function<br> isClient := zdir;<br> //CloseFile(F);<br> exit;<br> end;<br> end;<br> CloseFile(F);<br> isClient := '';<br> end;</p> <p>procedure TfrmMain.FormCreate(Sender: TObject);<br> begin<br> bConnected := false;<br> UserFile := apppath + 'users.txt';<br> LoadUserList;<br> end;</p> <p>procedure TfrmMain.ToolButton4Click(Sender: TObject);<br> begin<br> if bConnected = true then<br> begin<br> if MessageDlg('Warning stoping the FTP server will disconnect any clients!' + chr(10) + 'Are you sure you want to stop the FTP server?',mtConfirmation, [mbYes, mbNo], 0) = mrYes then<br> begin<br> frmmain.FtpServer1.DisconnectAll;<br> //clear the list<br> listview1.Items.Clear;<br> Logit('All Users Booted');<br> end;<br> end;<br> end;</p> <p></p> <p>procedure TfrmMain.TabSheet3Exit(Sender: TObject);<br> begin<br> listview1.Items := listview2.Items;<br> listview2.Items.Clear;<br> end;</p> <p>procedure TfrmMain.TabSheet3Enter(Sender: TObject);<br> begin<br> listview2.Items := listview1.Items;<br> end;</p> <p>function TfrmMain.getClientRootDir(sUser : String): String;<br> Var<br> I : Integer;<br> ListItem: TListItem;<br> begin<br> for i := 0 to listview1.Items.count - 1 do<br> begin<br> ListItem := listview1.Items[i];<br> if lowercase(suser) = lowercase(ListItem.Caption) then<br> begin<br> getClientRootDir := listitem.SubItems[1];<br> exit;<br> end;<br> end;<br> getClientRootDir := '';</p> <p>end;</p> <p>procedure TfrmMain.Timer1Timer(Sender: TObject);<br> begin<br> Panel2.Caption := 'Local IP Addess: ' + GetLocalIP;<br> statusbar1.Panels[1].text := 'Number of Users: ' + inttostr(listview1.Items.count);<br> end;</p> <p>procedure TfrmMain.BitBtn2Click(Sender: TObject);<br> begin<br> if bConnected = true then<br> begin<br> showmessage('Please Stop FTP Server before applying these options.');<br> exit;<br> end;<br> FtpServer1.Banner := txtbanner.Text;<br> FtpServer1.MaxClients := SpinEdit1.Value;<br> FtpServer1.Port := inttostr(SpinEdit2.Value);<br> end;</p> <p>procedure TfrmMain.BitBtn3Click(Sender: TObject);<br> begin<br> if bConnected = true then<br> begin<br> showmessage('Please Stop FTP Server before applying these options.');<br> exit;<br> end;<br> txtbanner.Text := '220 Personal FTP Ready';<br> SpinEdit1.Value := 200;<br> SpinEdit2.Value := 21;<br> FtpServer1.Banner := txtbanner.Text;<br> FtpServer1.MaxClients := SpinEdit1.Value;<br> FtpServer1.Port := inttostr(SpinEdit2.Value);<br> end;</p> <p>procedure TfrmMain.ToolButton10Click(Sender: TObject);<br> begin<br> //dump the listview2 contents to the user file<br> bSaveUserList;<br> //TO DO - update all logged in clients<br> //Maybe I will do this in the next version?</p> <p>end;</p> <p>procedure TfrmMain.ToolButton13Click(Sender: TObject);<br> var<br> ListItem: TListItem;<br> I : Integer;<br> bTMP : Boolean;<br> begin<br> //add a user<br> frmnewuser.showmodal;<br> if frmnewuser.Execute = true then<br> begin<br> //make sure we are not adding a duplicate<br> for i := 0 to listview1.Items.Count -1 do<br> begin<br> ListItem := listview2.Items[i];<br> if lowercase(listitem.caption) = lowercase(frmnewuser.txtuser.text) then<br> begin<br> //duplicate found<br> showmessage('User Already Exists');<br> exit;<br> end;</p> <p>end;<br> //duplicate not found, add new user<br> ListItem := listview2.Items.Add;<br> ListItem.Caption := frmnewuser.txtuser.text;<br> listitem.SubItems.Add(frmnewuser.txtPassword.text); //password<br> listitem.SubItems.Add(frmnewuser.DirectoryListBox1.Directory); //root dir<br> listitem.SubItems.Add(bmakestring(frmnewuser.chkUpload.checked));//upload<br> listitem.SubItems.Add(bmakestring(frmnewuser.chkdownload.checked));//download<br> listitem.SubItems.Add(bmakestring(frmnewuser.chkrename.checked));//rename<br> listitem.SubItems.Add(bmakestring(frmnewuser.chkdelete.checked));//delete<br> //reset the wizard<br> frmnewuser.txtUser.Text := 'Anonymous';<br> frmnewuser.txtPassword.Text := 'Guest';<br> frmnewuser.chkUpload.checked := false;<br> frmnewuser.chkdownload.checked := false;<br> frmnewuser.chkrename.checked := false;<br> frmnewuser.chkdelete.checked := false;<br> end;</p> <p>end;</p> <p>procedure TfrmMain.ToolButton14Click(Sender: TObject);<br> begin<br> //remove selected user<br> if listview2.SelCount > 0 then<br> begin<br> listview2.Items.Delete(listview2.Selected.Index);<br> end;<br> end;</p> <p>procedure TfrmMain.LoadUserList();<br> var<br> F: TextFile;<br> S: string;<br> zTMP: String;<br> ListItem: TListItem;<br> begin<br> //load the user list into listview2<br> AssignFile(F, UserFile); { File selected in dialog box }<br> Reset(F);<br> //read the file line by line<br> while not EOF(F) do<br> begin<br> Readln(F, S); { Read the first line out of the file }<br> //add it to the list<br> listitem := ListView2.Items.Add;<br> listitem.Caption := getlineele(s,'<user>','</user>'); //username<br> listitem.SubItems.Add(getlineele(s,'<password>','</password>')); //password<br> listitem.SubItems.Add(getlineele(s,'<root>','</root>')); //root dir<br> listitem.SubItems.Add(getlineele(s,'<up>','</up>'));//upload<br> listitem.SubItems.Add(getlineele(s,'<down>','</down>'));//download<br> listitem.SubItems.Add(getlineele(s,'<rename>','</rename>'));//rename<br> listitem.SubItems.Add(getlineele(s,'<delete>','</delete>'));//delete<br> end;<br> CloseFile(F);<br> end;<br> procedure TfrmMain.SaveUserList();<br> begin<br> //save the user list from listview2</p> <p>end;<br> procedure TfrmMain.ListView2SelectItem(Sender: TObject; Item: TListItem;<br> Selected: Boolean);<br> begin<br> txtuser.Text := item.Caption;</p> <p>txtpassword.text := item.SubItems.Strings[0];<br> txtroot.text := item.SubItems.Strings[1];<br> chkupload.checked := bMakeBoolean(item.SubItems.Strings[2]); //upload<br> chkdownload.checked := bMakeBoolean(item.SubItems.Strings[3]);//download<br> chkrename.checked := bMakeBoolean(item.SubItems.Strings[4]);//rename<br> chkdelete.checked := bMakeBoolean(item.SubItems.Strings[5]);//delete</p> <p>end;<br> procedure TfrmMain.EditClient();<br> Var<br> ListItem: TListItem;<br> begin<br> //exit if none in list<br> if listview2.items.count = 0 then exit;<br> //exit if none selected<br> if listview2.SelCount = 0 then exit;<br> //set our listview item<br> ListItem := listview2.Selected;<br> if txtUser.text = '' then txtuser.text := 'Anonymous';<br> if txtpassword.text = '' then txtpassword.text := 'Guest';</p> <p><br> listitem.Caption := txtuser.text;<br> listitem.SubItems[0] := txtpassword.text; //password<br> listitem.SubItems[1] := txtroot.text; //root dir<br> listitem.SubItems[2] := bMakeString(chkupload.checked); //upload<br> listitem.SubItems[3] := bMakeString(chkdownload.checked);//download<br> listitem.SubItems[4] := bMakeString(chkrename.checked); //rename<br> listitem.SubItems[5] := bMakeString(chkdelete.checked); //delete<br> end;</p> <p>procedure TfrmMain.BitBtn1Click(Sender: TObject);<br> begin<br> //show the browse for dir dialog;<br> if directoryexists(txtroot.text) = true then<br> frmdir.DirectoryListBox1.Directory := txtroot.text;</p> <p>frmdir.showmodal;<br> if frmdir.Execute = true then<br> txtRoot.Text := frmdir.DirectoryListBox1.Directory;</p> <p>end;</p> <p>procedure TfrmMain.BitBtn4Click(Sender: TObject);<br> begin<br> editclient;<br> end;</p> <p>procedure TfrmMain.ListView2MouseUp(Sender: TObject; Button: TMouseButton;<br> Shift: TShiftState; X, Y: Integer);<br> begin<br> if listview2.SelCount = 0 then<br> begin<br> txtuser.Text := '';<br> txtpassword.text := '';<br> txtroot.Text := '';<br> chkupload.Checked := false;<br> chkdownload.Checked := false;<br> chkrename.checked := false;<br> chkdelete.checked := false;<br> end;<br> end;<br> procedure TfrmMain.bSaveUserList();<br> var<br> F: TextFile;<br> S: string;<br> ListItem: TListItem;<br> I : Integer;<br> begin<br> //save the user list from listview2<br> AssignFile(F, UserFile); { File selected in dialog box }<br> Rewrite(F);<br> for i := 0 to listview2.Items.Count -1 do<br> begin<br> ListItem := listview2.Items[i];<br> s := '<user>' + listitem.Caption + '</user>';<br> s := s + '<password>' + listitem.SubItems.Strings[0] + '</password>';<br> s := s + '<root>' + listitem.SubItems.Strings[1] + '</root>';<br> s := s + '<up>' + listitem.SubItems.Strings[2] + '</up>';<br> s := s + '<down>' + listitem.SubItems.Strings[3] + '</down>';<br> s := s + '<rename>' + listitem.SubItems.Strings[4] + '</rename>';<br> s := s + '<delete>' + listitem.SubItems.Strings[5] + '</delete>';<br> Writeln(F, s);<br> end;</p> <p>CloseFile(F);<br> end;</p> <p>procedure TfrmMain.ToolButton9Click(Sender: TObject);<br> begin<br> //reload the list<br> listview2.Items.Clear;<br> LoadUserList;<br> if listview2.SelCount = 0 then<br> begin<br> txtuser.Text := '';<br> txtpassword.text := '';<br> txtroot.Text := '';<br> chkupload.Checked := false;<br> chkdownload.Checked := false;<br> chkrename.checked := false;<br> chkdelete.checked := false;<br> end;<br> end;</p> <p>procedure TfrmMain.ToolButton6Click(Sender: TObject);<br> begin<br> //save the log file as...<br> if savedialog1.Execute = true then<br> begin<br> RichEdit1.Lines.SaveToFile(savedialog1.filename);<br> end;</p> <p>end;</p> <p>procedure TfrmMain.TheServer1Click(Sender: TObject);<br> begin<br> PageControl1.ActivePage := tabsheet1;<br> end;</p> <p>procedure TfrmMain.ActivityLog1Click(Sender: TObject);<br> begin<br> PageControl1.ActivePage := tabsheet2;<br> end;</p> <p>procedure TfrmMain.AllowedUsers1Click(Sender: TObject);<br> begin<br> PageControl1.ActivePage := tabsheet3;<br> end;</p> <p>procedure TfrmMain.ExtraOptions1Click(Sender: TObject);<br> begin<br> PageControl1.ActivePage := tabsheet4;<br> end;<br> function TfrmMain.IsAllowedTo(sUser : String; IAction : Integer): Boolean;<br> Var<br> ListItem: TListItem;<br> I : Integer;<br> begin<br> //see if the client is allowed to do something<br> for i := 0 to listview1.Items.Count -1 do<br> begin<br> listitem := listview1.items[i];<br> //see if it is the client<br> if lowercase(suser) = lowercase(listitem.caption) then<br> begin<br> IsAllowedTo := bMakeBoolean(listitem.SubItems.Strings[IAction]);<br> exit;<br> end;<br> end;<br> //not found - return false just to be safe<br> IsAllowedTo := false;<br> end;</p> <p>procedure TfrmMain.Help2Click(Sender: TObject);<br> begin<br> showmessage('Sorry no Help File');<br> end;</p> <p>procedure TfrmMain.About1Click(Sender: TObject);<br> begin<br> frmabout.showmodal;<br> end;</p> <p>procedure TfrmMain.Exit1Click(Sender: TObject);<br> begin<br> close;<br> end;</p> <p>end.</p> </td> </tr> </table> <table border="0" width="93%" align="center"> <tr> <td width="61%"><font face="Arial, Verdana" size="2"><a href="mailto:i@cooler.com.ua?subject=subscribe">Zaluskiy Anton</a>(<font color="blue"><a>COOLer</a></font><a><font color="#800000">)</font><font color="#ff0000"> и</font><font color="#800000"> Khrapunov Kirill(Pixel) </font><font color="#ff0000"> </font><font color="#000080">- ведущие проекта </font></a><font color="#000080"><a target="_new" href="http://delphi.bos.ru/">"Мир Delphi"</a></font></font></td> <td width="39%" bgcolor="#FF9900"><font color="#000000" size="1">(C) Pixelsoftware(Pixel)& Delphi 2000-2002(COOLer)</font></td> </tr> <tr bgcolor="#FFCC66" align="center"> <td width="100%" colspan="2"> <div align="center"><br> <br> <a href="http://www.ozon.ru/index.cfm/partner=delphibos"><img alt="Озон!" src border="0"></a> <a target="_top" href="http://top.list.ru/jump?from=99400"><img height="31" alt="TopList" src width="88" border="0"></a> <script language="javascript"> u="u597.93.spylog.com";d=document;nv=navigator;na=nv.appName;p=0;j="N"; d.cookie="b=b";c=0;bv=Math.round(parseFloat(nv.appVersion)*100); if (d.cookie) c=1;n=(na.substring(0,2)=="Mi")?0:1;rn=Math.random(); z="p="+p+"&rn="+rn+"&c="+c;if (self!=top) {fr=1;} else {fr=0;} sl="1.0";</script> <script language="javascript1.1"> pl="";sl="1.1";j = (navigator.javaEnabled()?"Y":"N");</script> <script language="javascript1.2"> sl="1.2";s=screen;px=(n==0)?s.colorDepth:s.pixelDepth; z+="&wh="+s.width+'x'+s.height+"&px="+px; </script> <script language="javascript1.3"> sl="1.3"</script> <script language="javascript"> y="";y+="<a href='http://"+u+"/cnt?f=3&p="+p+"&rn="+rn+";' target=_blank>"; y+="<img src='http://"+u+"/cnt?"+z+"&j="+j+"&sl="+sl+ "&r="+escape(d.referrer)+"&fr="+fr+"&pg="+escape(window.location.href); y+="' border=0 width=88 height=31 alt='SpyLOG'>"; y+="</a>"; d.write(y);if(!n) { d.write("<"+"!--"); }//--></script> <a target="_blank" href="http://u597.93.spylog.com/cnt?f=3&p=0&rn=0.681382008475365"><img height="31" alt="SpyLOG" src="http://u597.93.spylog.com/cnt?p=0&rn=0.681382008475365&c=1&wh=1024x768&px=16&j=Y&sl=1.3&r=&fr=0&pg=file%3A///D%3A/upload/fresh.htm"; width="88" border="0"></a> <a target="_top" href="http://btn2.linkexchange.ru/users/058163/goto.map?bn=0"><img height="60" alt="RLE Banner Network" src="http://btn2.linkexchange.ru/cgi-bin/rle.cgi?58163-bn=0?Rnd_Num"; width="120" border="0"></a> </div> </td> </tr> </table> <center> <table width="93%" border="0" align="center"> <tbody> <tr bgcolor="#0000FF"> <td vAlign="top" align="left" bgcolor="#FF9900"><a target="_top" href="http://subscribe.ru/"><font color="#000000">http://subscribe.ru/</font></a><font color="#000000"><br> E-mail: <a href="mailto:ask@subscribe.ru">ask@subscrib</a></font><font color="#FFFFFF"><a href="mailto:ask@subscribe.ru">e.ru</a></font></td> <td vAlign="top" align="middle" bgcolor="#FF9900"><a target="_top" href="http://subscribe.ru/member/unsub?grp=comp.soft.prog.delphi2000"><font color="#000000">Отписаться</font></a><font color="#FFFFFF"><br> <a target="_top" href="http://link.subscribe.ru/noad">;Убрать рекламу</a></font></td> <td vAlign="top" align="right" bgcolor="#FF9900"><font color="#000000">Рейтингуется <a href="http://topmail.spylog.ru/">SpyLog</a></font></td>; </tr> </tbody> </table> </center> <img height="1" src width="1"><img height="1" src width="1" border="0"> <p align="center"><font face="Arial, Arial, Helvetica"> <iframe src="http://b.abn.com.ua/abn.php?t=120&id=1335&r=1&m=1&"; width=120 height=60 frameborder=0 vspace=0 hspace=0 marginwidth=0 marginheight=0 scrolling=no> <a href="http://b.abn.com.ua/abnl.php?t=120&id=1335&r=1"; target=_blank><img src="http://b.abn.com.ua/abni.php?t=120&id=1335&r=1"; alt="Another Banner Network" height=60 width=120 border=0 ismap></a> </iframe> </font> <p align="center"> <iframe src="http://b.abn.com.ua/abn.php?t=&id=2722&r=1&m=1&"; width=468 height=60 frameborder=0 vspace=0 hspace=0 marginwidth=0 marginheight=0 scrolling=no> <a href="http://b.abn.com.ua/abnl.php?t=&id=2722&r=1"; target=_blank><img src="http://b.abn.com.ua/abni.php?t=&id=2722&r=1"; alt="Another Banner Network" height=60 width=468 border=0 ismap align="middle"></a> </iframe> </td> </tr> </table> <p align="center"><iframe src="http://rle3.rle.ru/cgi-bin/erle.cgi?sid=458?bt=1?pz=3?sz=/comp.soft.prog?rnd=404445162"; frameborder=0 vspace=0 hspace=0 width=468 height=60 marginwidth=0 marginheight=0 scrolling=no></iframe> <x/BODY> <x/HTML> <script language="JavaScript" src="http://rle3.rle.ru/cgi-bin/erle.cgi?sid=458?bt=16?pz=0?sz=/comp.soft.prog?rnd=613217747"></script>;
| http://subscribe.ru/
E-mail: ask@subscribe.ru |
Отписаться
Убрать рекламу |
| В избранное | ||
