求多线程网络传输文件原码,用WINSOCK API编写。(200分)

  • 主题发起人 主题发起人 bobo158
  • 开始时间 开始时间
B

bobo158

Unregistered / Unconfirmed
GUEST, unregistred user!
我的问题是:
SERVER 端有一个文件(300K)没隔5秒会更新一次,SERVER 要把新文件发送给20个客户端。
原来用CLIENTSOCKET,和SERVERSOCKET作,效率较低,故考虑用API作多线程的,苦于没有学习研究的代码。请各位帮忙。
 
可不可以反过来整,客户端每隔一定时间,检查服务器是否有可用的文件,我想这样的好处多一点.
 
to luzhouman:有代码吗?发给我一份。
 
反过来就要在服务器生成数据以提供客户端需要更新时更新请求.
 
当然,需要生成更新文件的信息列表
 
有谁能发给我WINSOCK API编写的代码啊。
 
rainboy5908的做法可行,这种方式还得用到线程建议用
createthread这个函数另外我不赞赏楼主的做法动不动就要大段实用的源码,请尊重别人r 劳动虽然这个技术早已不是什么值钱的东西.
 
http://www.delphibbs.com/keylife/iblog.asp?author=jfyes
 
to wugwdelphi:
我是用于学习和研究的,研究别人的代码难道不是一个很好和有效率的学习方式吗?论坛不就是提供大家交流的场所吗?如果你不愿意帮助我,也不要打击我寻求帮助的努力。
 
谢谢jfyes,我看看先。
 
楼主,别为自己不努力而找什么借口,至少你得先努力去编得试试,我并没有要打击你。
就此打住,再不回贴!
 
jfyes:你好,感谢你的帮助,我看了你的代码,都缺少一些文件,不能编译。
如:UPD传输文件060404:
UDPTransFiles.dpr中引用了如下文件
XStdCtrls.pas
XCommCtrls.pas
winsock2.pas
XWinSock2.pas
XCommDlg.pas
能把这些文件发给我吗?收到一定放分,谢谢。
to:wugwdelphi,做人要厚道。
 
winsock2.pas XWinSock2.pas 关键单元有了。
在笔记最下面
 
XCommCtrls.pas 不要,没有引用到。

{***************************************************************}
{ }
{ PraiseSoft SoftWare System }
{ Copyright(c) 2004-2005 PraiseSoft Software Corporation }
{ SoftWareName: XCommDlg SDK }
{ Version: V1.0 }
{ DevIDE: Delphi7.0 Windows 2000 Professional }
{ Build: 2006-03-02 }
{ Author: jfyes Email: jf_yes@126.com QQ: 348677065 }
{ Function: System Dialog }
{ Description: Delphi for Windows SDK }
{ Noteice: 1.本信息资料仅用于个人和非商业用途,复制请保留此信息,}
{ 未经作者书面许可,不得作任何商业(营利性)用途。 }
{ 2.如用本信息资料,制造违法信息/软件,本人不负任何法律 }
{ 责任。 }
{ 3.如有修改请发份源码给我,谢谢! }
{***************************************************************}

unit XCommDlg;

interface

uses
Windows, CommDlg;

function OpenDialog(const FileName, Filter: PChar;
const Dir: PChar = nil; const Handle: THandle = 0): BOOL;
//function OpenDialogs(const FileName, Filter, Dir: PChar): BOOL;
function SaveDialog(const FileName, Filter: PChar;
const Dir: PChar = nil; const Handle: THandle = 0): BOOL;

implementation

//打开多个文件
//function OpenDialogs(const FileName, Filter, Dir: PChar): BOOL;

function SaveDialog(const FileName, Filter, Dir: PChar;
const Handle: THandle): BOOL;
var
OpenObj: TOpenFilename;
begin
FillChar(OpenObj, SizeOf(OpenObj), 0);
OpenObj.lStructSize := SizeOf(OpenObj);
if Handle = 0 then
OpenObj.hWndOwner := GetActiveWindow()
else OpenObj.hWndOwner := Handle;
OpenObj.hInstance := hInstance;
OpenObj.lpstrFile := FileName;
OpenObj.lpstrFilter := Filter;
OpenObj.lpstrFileTitle := 'Save file';
if Dir = nil then OpenObj.lpstrInitialDir := '.'
else OpenObj.lpstrInitialDir := Dir;
OpenObj.nFilterIndex := 0;
OpenObj.nMaxFile := 256;
OpenObj.Flags := OFN_HIDEREADONLY or OFN_EXPLORER;
Result := CommDlg.GetSaveFileName(OpenObj);
end;

function OpenDialog(const FileName, Filter, Dir: PChar;
const Handle: THandle): BOOL;
var
OpenObj: TOpenFilename;
begin
FillChar(OpenObj, SizeOf(OpenObj), 0);
OpenObj.lStructSize := SizeOf(OpenObj);
if Handle = 0 then
OpenObj.hWndOwner := GetActiveWindow()
else OpenObj.hWndOwner := Handle;
OpenObj.hInstance := hInstance;
OpenObj.lpstrFile := FileName;
if Filter = nil then OpenObj.lpstrFilter := 'All file(*.*)'#0'*.*'
else OpenObj.lpstrFilter := Filter;
OpenObj.lpstrFileTitle := 'Open file';
if Dir = nil then OpenObj.lpstrInitialDir := '.'
else OpenObj.lpstrInitialDir := Dir;
OpenObj.nFilterIndex := 0;
OpenObj.nMaxFile := 256;
OpenObj.Flags := OFN_HIDEREADONLY or OFN_EXPLORER;
Result := CommDlg.GetOpenFileName(OpenObj);
end;


end.


{***************************************************************}
{ }
{ PraiseSoft SoftWare System }
{ Copyright(c) 2004-2005 PraiseSoft Software Corporation }
{ SoftWareName: Windows API Standard GUIs }
{ Version: V1.0 }
{ DevIDE: Delphi7.0 Windows 2000 Professional }
{ Build: 2005-12-02 }
{ Author: jfyes Email: jf_yes@163.com }
{ Function: }
{ Description: Delphi for Windows SDK }
{ Noteice: 1.本信息资料仅用于个人和非商业用途,复制请保留此信息,}
{ 未经作者书面许可,不得作任何商业(营利性)用途。 }
{ 2.如用本信息资料,制造违法信息/软件,本人不负任何法律 }
{ 责任。 }
{***************************************************************}

unit XStdCtrls;

interface

uses
Windows, Messages;

const // 10 system global GUIs
TEdit = 'Edit';
TMemo = 'Memo';
TButton = 'Button';
TRadio = 'Radio';
TCheckBox = 'CheckBox';
TGroupBox = 'GroupBox';
TComboBox = 'Combobox';
TListBox = 'Listbox';
TLabel = 'static';
TScrollBar = 'ScrollBar';


// 注册一个Window类
function RegistryClass(const ClassName: PChar; const lpFunc: Pointer): WORD;

// Create system global GUIs
function CreateStdWnd(lpClassName: PChar;
const lpCaption: PChar = nil; const Parent: HWND = 0;
const X: Integer = 0; const Y: Integer = 0;
const W: Integer = 0; const H: Integer = 0;
const Style: DWORD = WS_CHILD or WS_VISIBLE or WS_TABSTOP;
const ExStyle: DWORD = WS_EX_CLIENTEDGE): HWND;

function CreateStdWndW(lpClassName: PWideChar;
const lpCaption: PWideChar = nil; const Parent: HWND = 0;
const X: Integer = 0; const Y: Integer = 0;
const W: Integer = 0; const H: Integer = 0;
const Style: DWORD = WS_CHILD or WS_VISIBLE or WS_TABSTOP;
const ExStyle: DWORD = WS_EX_CLIENTEDGE): HWND;

function Now: TSystemTime;
function ShowMessage(lpText: PChar; const OwnerHwnd: HWND = 0;
const BtnType: DWORD = MB_OK + MB_ICONHAND): BOOL;
procedure ShowErrorMsg(MSG: PChar; const Handle: HWND = 0);
procedure ShowWarningMsg(MSG: PChar; const Handle: HWND = 0);
procedure ShowInfoMsg(MSG: PChar; const Handle: HWND = 0);
procedure WindowGetText(Handle: HWND; var Text: PChar);
function GetWndText(Handle: HWND): PChar;
function FormatChar(OutPut: PChar; lpFormat: PChar; arglist: array of Integer): Integer;

{ Memo }
procedure MemoReadonly(Handle: HWND; const ReadOnly: BOOL = True);
procedure MemoClear(Handle: HWND);
function MemoCount(Handle: HWND): Integer;
procedure MemoAdd(Handle: HWND; const S: PChar);
procedure MemoPut(Handle: HWND; Index: Integer; const S: PChar);
procedure MemoInsert(Handle: HWND; Index: Integer; const S: PChar);

{ Edit }
procedure EdtReadonly(Handle: HWND; const ReadOnly: BOOL = True);
procedure EdtClear(Handle: HWND);
procedure EdtSetTextW(Handle: HWND; Value: PWideChar);
procedure EdtSetText(Handle: HWND; Value: PChar);
procedure EdtSetMaxLength(Handle: HWND; Value: Integer);


{ Font }
function MakeFont(AFontName: string; aSize: Integer;
const fdwItalic: DWORD = 0; const fdwUnderline: DWORD = 0): HFONT;
procedure SetChildWNDFont(hMain: HWND; const FontName: PChar = nil; const FontSize: Integer = 9);
function SetFont(hWnd: HWND; FontName: PChar; FontSize: Integer): BOOL;

implementation

{ Memo }
procedure MemoReadonly(Handle: HWND; const ReadOnly: BOOL);
begin
EdtReadonly(Handle, ReadOnly);
end;

procedure MemoClear(Handle: HWND);
begin
EdtClear(Handle);
end;

function MemoCount(Handle: HWND): Integer;
begin
Result := SendMessage(Handle, EM_GETLINECOUNT, 0, 0);
if SendMessage(Handle, EM_LINELENGTH,
SendMessage(Handle, EM_LINEINDEX, Result - 1, 0), 0) = 0 then
Dec(Result);
end;

procedure MemoAdd(Handle: HWND; const S: PChar);
var
Index: Integer;
begin
Index := MemoCount(Handle);
if Index < 0 then Index := 0;
MemoInsert(Handle, Index, S);
end;

procedure MemoInsert(Handle: HWND; Index: Integer; const S: PChar);
var
SelStart, LineLen: Integer;
Line: PChar;
begin
if Index >= 0 then
begin
GetMem(Line, lstrlen(S) + 3);
SelStart := SendMessage(Handle, EM_LINEINDEX, Index, 0);
if SelStart >= 0 then begin
Windows.lstrcpy(Line, S);
Windows.lstrcat(Line, #13#10);
end
else begin
SelStart := SendMessage(Handle, EM_LINEINDEX, Index - 1, 0);
if SelStart < 0 then Exit;
LineLen := SendMessage(Handle, EM_LINELENGTH, SelStart, 0);
if LineLen = 0 then Exit;
Inc(SelStart, LineLen);
Windows.lstrcpy(Line, #13#10);
Windows.lstrcat(Line, S);
end;
SendMessage(Handle, EM_SETSEL, SelStart, SelStart);
SendMessage(Handle, EM_REPLACESEL, 0, Longint(PChar(Line)));
end;
end;

procedure MemoPut(Handle: HWND; Index: Integer; const S: PChar);
var
SelStart: Integer;
begin
SelStart := SendMessage(Handle, EM_LINEINDEX, Index, 0);
if SelStart >= 0 then
begin
SendMessage(Handle, EM_SETSEL, SelStart, SelStart +
SendMessage(Handle, EM_LINELENGTH, SelStart, 0));
SendMessage(Handle, EM_REPLACESEL, 0, Longint(S));
end;
end;


{ Edit }
procedure EdtReadonly(Handle: HWND; const ReadOnly: BOOL);
begin
SendMessage(Handle, EM_SETREADONLY, Ord(ReadOnly), 0);
end;

procedure EdtClear(Handle: HWND);
begin
SendMessage(Handle, WM_SETTEXT, 0, 0);
end;

procedure EdtSetTextW(Handle: HWND; Value: PWideChar);
begin
SendMessage(Handle, WM_SETTEXT, 0, Longint(Value));
end;

procedure EdtSetText(Handle: HWND; Value: PChar);
begin
SendMessage(Handle, WM_SETTEXT, 0, Longint(Value));
end;

procedure EdtSetMaxLength(Handle: HWND; Value: Integer);
begin
// 该GUI的style 必须有ES_AUTOHSCROLL才能自动,否则直到尾部就不能在写缓冲了。
SendMessage(Handle, EM_LIMITTEXT, Value, 0);
end;


function CreateStdWnd(lpClassName: PChar;
const lpCaption: PChar = nil; const Parent: HWND = 0;
const X: Integer = 0; const Y: Integer = 0;
const W: Integer = 0; const H: Integer = 0;
const Style: DWORD = WS_CHILD or WS_VISIBLE or WS_TABSTOP;
const ExStyle: DWORD = WS_EX_CLIENTEDGE): HWND;
var
ExStyles, Styles: DWORD;
ClassName: array[0..128]of Char;
begin
ExStyles := ExStyle;
Styles := Style;
ClassName := TButton;
if lpClassName = TEdit then begin
ClassName := TEdit;
Styles := Styles or WS_BORDER or ES_LEFT or ES_AUTOHSCROLL;
end
else if lpClassName = TMemo then begin
ClassName := TEdit;
Styles := Styles or ES_AUTOVSCROLL or ES_AUTOHSCROLL or
WS_HSCROLL or WS_VSCROLL or ES_MULTILINE or ES_WANTRETURN;
end
else if lpClassName = TButton then begin
Styles := Styles or BS_MULTILINE or BS_PUSHBUTTON or BS_DEFPUSHBUTTON;
end
else if lpClassName = TRadio then begin
Styles := Styles or BS_MULTILINE or BS_AUTORADIOBUTTON;
end
else if lpClassName = TCheckBox then begin
Styles := Styles or BS_MULTILINE or BS_AUTOCHECKBOX;
end
else if lpClassName = TGroupBox then begin
Styles := Styles or BS_GROUPBOX or CS_HREDRAW or CS_VREDRAW;
end
else if lpClassName = TListBox then begin
ClassName := TListBox;
Styles := Styles or LBS_STANDARD or LBS_DISABLENOSCROLL or LBS_NOINTEGRALHEIGHT or WS_BORDER;
end
else if lpClassName = TLabel then begin
ClassName := TLabel; //SS_SUNKEN or WS_BORDER;
Styles := Styles or SS_LEFT or SS_NOTIFY;
ExStyles := 0;
end
else if lpClassName = TComboBox then begin
ClassName := TComboBox;
Styles := Styles or WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL or CBS_DROPDOWN;
end
else if lpClassName = TScrollBar then begin
ClassName := TScrollBar;
Styles := Styles or LBS_STANDARD or LBS_DISABLENOSCROLL or LBS_NOINTEGRALHEIGHT or WS_BORDER;
end else
Windows.lstrcpy(ClassName, lpClassName);
Result := Windows.CreateWindowEx(ExStyles, ClassName, lpCaption, Styles,
X, Y, W, H, Parent, 0, HInstance, nil);
end;

function CreateStdWndW(lpClassName: PWideChar;
const lpCaption: PWideChar = nil; const Parent: HWND = 0;
const X: Integer = 0; const Y: Integer = 0;
const W: Integer = 0; const H: Integer = 0;
const Style: DWORD = WS_CHILD or WS_VISIBLE or WS_TABSTOP;
const ExStyle: DWORD = WS_EX_CLIENTEDGE): HWND;
var
ExStyles, Styles: DWORD;
ClassName: array[0..128]of WideChar;
begin
ExStyles := ExStyle;
Styles := Style;
Windows.lstrcpyW(ClassName, TButton);
if lpClassName = TEdit then begin
Windows.lstrcpyW(ClassName, TEdit);
Styles := Styles or WS_BORDER or ES_LEFT;
end
else if lpClassName = TMemo then begin
Windows.lstrcpyW(ClassName, TEdit);
Styles := Styles or ES_AUTOVSCROLL or ES_AUTOHSCROLL or
WS_HSCROLL or WS_VSCROLL or ES_MULTILINE;
end
else if lpClassName = TButton then begin
Styles := Styles or BS_MULTILINE or BS_PUSHBUTTON or BS_DEFPUSHBUTTON;
end
else if lpClassName = TRadio then begin
Styles := Styles or BS_MULTILINE or BS_AUTORADIOBUTTON;
end
else if lpClassName = TCheckBox then begin
Styles := Styles or BS_MULTILINE or BS_AUTOCHECKBOX;
end
else if lpClassName = TGroupBox then begin
Styles := Styles or BS_GROUPBOX or CS_HREDRAW or CS_VREDRAW;
end
else if lpClassName = TListBox then begin
Windows.lstrcpyW(ClassName, TListBox);
Styles := Styles or LBS_STANDARD or LBS_DISABLENOSCROLL or LBS_NOINTEGRALHEIGHT or WS_BORDER;
end
else if lpClassName = TLabel then begin
Windows.lstrcpyW(ClassName, TLabel); //SS_SUNKEN or WS_BORDER;
Styles := Styles or SS_LEFT or SS_NOTIFY;
end
else if lpClassName = TComboBox then begin
Windows.lstrcpyW(ClassName, TComboBox);
Styles := Styles or WS_VSCROLL or CBS_HASSTRINGS or CBS_AUTOHSCROLL or CBS_DROPDOWN;
end
else if lpClassName = TScrollBar then begin
Windows.lstrcpyW(ClassName, TScrollBar);
Styles := Styles or LBS_STANDARD or LBS_DISABLENOSCROLL or LBS_NOINTEGRALHEIGHT or WS_BORDER;
end else
Windows.lstrcpyW(ClassName, lpClassName);
Result := Windows.CreateWindowExW(ExStyles, ClassName, lpCaption, Styles,
X, Y, W, H, Parent, 0, HInstance, nil);
end;

procedure ShowErrorMsg(MSG: PChar; const Handle: HWND);
begin
ShowMessage(MSG, MB_OK + MB_ICONERROR, Handle);
end;

procedure ShowWarningMsg(MSG: PChar; const Handle: HWND);
begin
ShowMessage(MSG, MB_OK + MB_ICONWARNING, Handle);
end;

procedure ShowInfoMsg(MSG: PChar; const Handle: HWND);
begin
ShowMessage(MSG, MB_OK + MB_ICONINFORMATION, Handle);
end;

function ShowMessage(lpText: PChar; const OwnerHwnd: HWND; const BtnType: DWORD): BOOL;
var
lpTitle: PChar;
H: HWND;
Len: Integer;
YESOK: Integer;
begin
YESOK := 0;
if (BtnType and MB_OKCANCEL = MB_OKCANCEL) then YESOK := IDOK
else if (BtnType and MB_YESNO = MB_YESNO) then YESOK := IDYES;
H := GetActiveWindow;
if OwnerHwnd <> 0 then H := OwnerHwnd;
Len := Windows.GetWindowTextLength(H) + 1;
Getmem(lpTitle, Len);
SendMessage(H, WM_GETTEXT, Len, Longint(lpTitle));
Result := Windows.MessageBox(H, lpText, lpTitle, BtnType) = YESOK;
FreeMem(lpTitle, Len);
end;

function Now: TSystemTime;
begin
Windows.GetLocalTime(Result);
end;

procedure WindowGetText(Handle: HWND; var Text: PChar);
var
Len: Integer;
begin
if Handle <> 0 then begin
Len := SendMessage(Handle, WM_GETTEXTLENGTH, 0, 0) + 1;
GetMem(Text, Len);
SendMessage(Handle, WM_GETTEXT, Len, Integer(Text));
end;
end;

function GetWndText(Handle: HWND): PChar;
var
Len: Integer;
begin
Result := nil;
if Handle <> 0 then begin
Len := SendMessage(Handle, WM_GETTEXTLENGTH, 0, 0) + 1;
GetMem(Result, Len);
SendMessage(Handle, WM_GETTEXT, Len, Integer(Result));
end;
end;

function FormatChar(OutPut: PChar; lpFormat: PChar; arglist: array of Integer): Integer;
begin
Result := Windows.wvsprintf(OutPut, lpFormat, @arglist[Low(arglist)]);
end;

function RegistryClass(const ClassName: PChar; const lpFunc: Pointer): WORD;
var
WNDClass: TWNDCLASS;
begin
//填充结构
FillChar(WNDClass, SizeOf(WNDClass), 0);
WNDClass.lpfnWndProc := lpFunc;
WNDClass.hInstance := hInstance;
WNDClass.hIcon := LoadICON(0, IDI_APPLICATION);
WNDCLass.hCursor := LoadCursor(0, IDC_ARROW);
WNDClass.lpszClassName := ClassName;
WNDClass.hbrBackground := 11;
//注册类
Result := Windows.RegisterClass(WNDClass);
end;

function MakeFont(AFontName: string; aSize: Integer;
const fdwItalic, fdwUnderline: DWORD): HFONT;
begin
Result := CreateFont(-aSize, // nHeight
0, // nWidth
0, // nEscapement
0, // nOrientaion
400, // fnWeight
fdwItalic, // fdwItalic
fdwUnderline, // fdwUnderline
0, // fdwStrikeOut
DEFAULT_CHARSET, // fdwCharSet
OUT_DEFAULT_PRECIS, // fdwOutputPrecision
CLIP_DEFAULT_PRECIS, // fdwClipPrecision
DEFAULT_QUALITY, // fdwQuality
DEFAULT_PITCH or FF_DONTCARE, // fdwPitchAndFamily
PChar(AFontName)); // lpszFace
end;

function SetFont(hWnd: HWND; FontName: PChar; FontSize: Integer): BOOL;
begin
Result := SendMessage(hWnd, WM_SETFONT, MakeFont(FontName, FontSize), 0) <> 0;
end;

var
AFontName: array [0..128] of Char;
AFontSize: Integer = 9;
procedure SetChildWNDFont(hMain: HWND; const FontName: PChar; const FontSize: Integer);
function SetChildWNDFontPrc(cH: HWND; lParam: Integer): BOOL; stdcall;
begin
SetFont(cH, AFontName, AFontSize);
Result := True;
end;
begin
if FontName = nil then AFontName := 'MS Sans Serif'
else Windows.lstrcpy(AFontName, FontName);

if FontSize <> 9 then AFontSize := FontSize;

Windows.EnumChildWindows(hMain, @SetChildWNDFontPrc, 0);
end;


end.
 
建议楼主不要用SDK写程序,生产力太低,而且容易出错, 练练手还行。
 
再次感谢jfyes大侠的热心帮助。我看看哈...
 
http://www.2ccc.com/downloads.asp?subcatalogid=106
 
谢谢各位。
 
能不能给源代码研究一下
谢谢!
yimianren6144@yahoo.com.cn
 
后退
顶部