征集源码例子(一)

microjuz 2003-08-11 09:17:19
想征集一些好的源码例子,希望大家不吝给小弟我学习一下。流,网络应用方面的例子更加欢迎。请大家在email中注明csdn的称呼,我一定给分,谢谢。
同时打出三张贴,这是一。不过我尽量不会在两长贴给同一个人分...keke
...全文
54 32 打赏 收藏 转发到动态 举报
写回复
用AI写文章
32 条回复
切换为时间正序
请发表友善的回复…
发表回复
bxh2dai 2003-08-16
  • 打赏
  • 举报
回复
up
warton 2003-08-16
  • 打赏
  • 举报
回复
到www.playicq.com找吧
microjuz 2003-08-16
  • 打赏
  • 举报
回复
收益=sy=??(呵呵,偶一脸坏笑)
zhoutian618 2003-08-16
  • 打赏
  • 举报
回复
UP
myling 2003-08-16
  • 打赏
  • 举报
回复
哈哈,又一个人疯了
senhor 2003-08-16
  • 打赏
  • 举报
回复
收益。。。
microjuz 2003-08-16
  • 打赏
  • 举报
回复
风焱你真是个疯子,你的信誉分怎么那么高拉,我的才加了一分,靠
不过你的例子偶还是喜欢的紧,keke,看看先
firetoucher 2003-08-16
  • 打赏
  • 举报
回复
//得到类的publish方法列表,刚刚写的,比较乱,不过大家可以玩玩
function ClassMethodNames(t:TClass): TStrings;
var
j,k:integer;
begin
k:=PInteger(PInteger(Integer(t) + vmtMethodTable)^)^ and $00FFFF;
j:=PInteger(Integer(t) + vmtMethodTable)^ + 2;
result:=TstringList.Create ;
while k>0 do
begin
result.Add(PShortString(j + 6)^);
k:=k-1;
j:= j+ Pinteger(j)^ and $00FFFF;
end;
end;
firetoucher 2003-08-16
  • 打赏
  • 举报
回复
//得到publish的field,用一个form试试:)
function ClassFieldNames(t:TClass): TStrings;
var
j,k,n:integer;
begin

result:=TstringList.Create ;
j:=PInteger(Integer(t) + vmtFieldTable)^;
if (j=0) then exit;
k:=PInteger(PInteger(Integer(t) + vmtFieldTable)^)^ and $00FFFF;
j:=PInteger(Integer(t) + vmtFieldTable)^ + 6;
n:=PShortInt(j + 6)^;
while k>0 do
begin
result.Add(PShortString(j + 6)^);
k:=k-1;
j:=j+ n+7;
n:=PShortInt(j + 6)^;
end;
end;
firetoucher 2003-08-16
  • 打赏
  • 举报
回复
关注一下此帖,希望大家支持,也好学习学习

--------------
暂定此帖为http://www.csdn.net/Subject/283/index.shtm候选
cow8063 2003-08-15
  • 打赏
  • 举报
回复
Email 服务器的简单实现
一. 设计思路

Email 系统采用C/S 结构。当用户想发送邮件时或收取邮件时在客户机上运行任意一个客户端程序,如Foxmail。在菜单’工具->选项’的邮件服务器里填上运行我们服务器程序的主机名。服务器主机24小时一直运行我们的服务器端程序,SMTP和POP3服务器程序分别在25端口和110端口侦听连接请求。当用户发信时,首先客户端会与服务器端建立Socket连接。然后开始一应一答的Client/Server间的通信。发信和收信时建立连接后服务器端分别要发送一个’250 OK’ 和’+OK pop3 server is ready ’的应答。客户端收到此应答后开始发送SMTP或POP3命令。POP3通信时一般最开始的命令是’user ‘和’pass’或’ apop’用以进行身份验证。注意由于POP3会话有3个状态,某些命令只在某特定状态下有效。当用户进行完所有的操作后发送一个’quit’命令。服务器端收到此命令即终止此次socket连接并继续侦听其他的连接请求。注意:POP3通信时客户端在Transaction状态下’quit’则进入update状态。如果从Authorization状态下’quit’则终止通信,而不进入Update状态。如果客户端不通过’quit’命令终止连接,POP3会话不会进入Update状态。而只有在Update状态下收到’quit’命令后服务器才会在断连前把标志为已删的邮件进行物理删除。

---- 二. 代码实现(以POP3为例)

---- 自定义TPOP类的描述:

SessionState = ( Init,Authorization, Transaction,Update);

TPop=class (TComponent)

public

UserName:string;//Email帐户名

PassWord:string; //Email口令

ReceText:Pchar; //server端收到的字符串

PopState:SessionState;

//pop状态:

init or authorization or transaction or update

MsgCount:integer; //邮件总数

SizeCount:integer; //邮件总大小

ReplyString:string;//服务器端发送的应答信息

DeleIndex:byte;//用户要删的邮件序号

ListIndex:byte;//list方法 的参数:

用户要列出的序号为listindex的邮件信息

RetrIndex:byte;//retr方法的参数:

用户要取序号为retrindex的邮件

TopIndex:byte; //top方法的参数

QuitFlag:boolean;//用户如果通过quit命断连则此变量为true;

反之(此时要把f_dele都置回0)

OldMsgCount:integer;//旧邮件数:Last 命令返回

//邮件头的各个域

HMsgId:string;

HReplyTo:string;

HDate:string;

HFrom:string;

HTo:string;

HSubject:string;

HMIME_Ver:real;

HContent_Type:string;

HContent_Transfer_Encoding:string;

HText:string;

//所有POP3服务器必须支持的命令

procedure user;

function pass:boolean;

procedure stat;

procedure dele;

procedure list;

procedure retr;

procedure noop;

procedure rset;

procedure aquit;

procedure tquit;

//扩展的可选择实现的POP3 命令

procedure top;

procedure last;

procedure apop;

procedure uidl;

end;

---- 1. 建立连接

---- 我们可以看到利用了Tclientsocket后客户端请求建立连接只需下面的代码。

with ClientSocket do

begin

Host := Server;

Active := True;

end;

---- 服务器端利用TserverSocket,一直在侦听110端口,若客户端有连接请求,则ServerSocketAccept事件会被激活,建立起连接。

procedure TMyForm.ServerSocketAccept(Sender: TObject;

Socket: TCustomWinSocket);

begin

Statusbar1.Panels[0].Text :=

'连接到 ' + Socket.RemoteAddress;

//pop对象初始化

pop:=TPop.Create(nil);

pop.PopState:=init;

pop.LoginResult:=false;

pop.QuitFlag:=false;

ServerSocket.Socket.Connections[0]

.sendtext('+OK ibonc pop3 server is ready'+crlf);

end;

---- 2. 通信

---- 服务器端收到客户端发来的信息,则会激活ServerSocketClientRead事件,通过ServerSocket的Socket.ReceiveText可以得到信息的内容。

procedure TMyForm.ServerSocketClientRead(Sender: TObject;

Socket: TCustomWinSocket);

var temp_command :string;

//存放接收到的命令行,并做去crlf的处理

begin

temp_command:=Socket.ReceiveText;

//to remove the crlf in command line

temp_command:=trim(copy(temp_command,1,

pos(crlf,temp_command)-1));

pop.ReceText:=pchar(temp_command);

if pop.popstate=init then

if strLIComp(pop.ReceText,'user ',5)=0 then

pop.user

else

ServerSocket.Socket.Connections[0]

.sendtext('-ERR user name please')

else if pop.popstate=authorization then

begin

if strLIComp(pop.ReceText,'pass ',5)=0 then

pop.pass

else if strIComp(pop.ReceText,'quit')=0 then

pop.aquit

else

ServerSocket.Socket.Connections[0]

.sendtext('-ERR pass word please');

end

else if pop.popstate=transaction then

begin

if strIComp(pop.ReceText,'stat')=0 then

pop.stat

else if strLIComp(pop.ReceText,'dele ',5)=0 then

pop.dele

else if strLIComp(pop.ReceText,'list',4)=0 then

pop.list

else if strLIComp(pop.ReceText,'retr ',5)=0 then

pop.retr

else if strIComp(pop.ReceText,'noop')=0 then

pop.noop

else if strIComp(pop.ReceText,'rset')=0 then

pop.rset

else if strIComp(pop.ReceText,'quit')=0 then

pop.tquit

else if strIComp(pop.ReceText,'last')=0 then

pop.last

else if strLIComp(pop.ReceText, 'apop ',5)=0 then

pop.apop

else if strLIComp(pop.ReceText, 'uidl ',5)=0 then

pop.uidl

else

ServerSocket.socket.connections[0]

.sendtext('-ERR no such command yet'+crlf);

end

end;

---- 3. 关闭连接

procedure TMyForm.ServerSocket

ClientDisconnect(Sender: TObject;

Socket: TCustomWinSocket);

begin

ServerSocket.Active := False;

//如果client端没有通过quit 命令断连,

则在断连时要把那些f_dele置为0

if pop.QuitFlag=False then

begin

MyForm.query11.Close;

MyForm.query11.Params[0].Asstring:=pop.UserName;

MyForm.query11.prepare;

MyForm.query11.execsql;

end;

end;




pandengzhe 2003-08-15
  • 打赏
  • 举报
回复
jsjs,大家多贡献两个,整理整理,一起学习
l_xiaofeng 2003-08-15
  • 打赏
  • 举报
回复
两个传送文件的例子。可能过于简单吧!


CSDN/l_xiaofeng(流水不腐)
fhuibo 2003-08-14
  • 打赏
  • 举报
回复
那方面的:
fhuibo@163.com
IORILI 2003-08-14
  • 打赏
  • 举报
回复
时我自己写的哟,搂住觉得怎么样 ^-^
IORILI 2003-08-14
  • 打赏
  • 举报
回复
procedure GetDirectories(list: TlistView; Directory: string; Item: Tlistitem; IncludeFiles: boolean);
var
SearchRec: TSearchRec;
begin
list.Items.BeginUpdate;//准备更新
list.Items.Clear; //清空list内容
if Directory[length(Directory)] <> '\' then //判断路径
Directory := Directory + '\'; //设置路径
if FindFirst(Directory + '*.*',faDirectory,SearchRec) = 0 then begin
repeat
if (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') then
begin
if (SearchRec.Attr and faDirectory > 0) then begin Item := list.Items.Add; //增加item
item.Caption:=SearchRec.Name;
item.ImageIndex:=6;
end;
GetDirectories(list,Directory + SearchRec.Name,Item,IncludeFiles);
end
else
if IncludeFiles then
if SearchRec.Name[1] <> '.' then
begin
item:=list.Items.Add;
item.Caption:=SearchRec.Name;
item.ImageIndex:=6;
end;
until FindNext(SearchRec) <> 0;
//FindClose(SearchRec);
end;
list.Items.EndUpdate;
end;

TListView组件显示文件夹中的文件,Directory:文件夹的路径
jbzj 2003-08-14
  • 打赏
  • 举报
回复
我也想要
IORILI 2003-08-14
  • 打赏
  • 举报
回复
想问各位前辈,我怎么样才能早点变星星呢 ^-^
jackie168 2003-08-14
  • 打赏
  • 举报
回复
小5,快升星了吧...............
l_xiaofeng 2003-08-14
  • 打赏
  • 举报
回复
我KAO,原来是天才弟弟,你需要哪方面的呀?一般我有需要的时候都去PLAYICQ,说说看我能不能帮你,我自己可没什么源码,离不开数据库的,对你来说肯定没用!
加载更多回复(12)

5,391

社区成员

发帖
与我相关
我的任务
社区描述
Delphi 开发及应用
社区管理员
  • VCL组件开发及应用社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧