How to create a shared folder in Win2000 and Win98

Last year I wrote 'using sqlserver's extended stored procedure for remote backup and recovery (http://www.csdn.net/Develop/read_article.asp? Id = 21304) 'Many people mentioned how to create shared folders in the program. I was busy with my work and only saw that my message was not answered in time, sorry for the inconvenience caused by the readers. In this article, I will list the code for creating shared folders in Win2000 and Win98 (including a series of related network functions) to help you.

Unit publib;

Interface

Uses
Windows, messages, sysutils, classes, graphics, controls, forms, dialogs,
Menus, comctrls, toolwin, DB, ADODB, dbctrls, stdctrls, math, dbgrids,
Buttons, extctrls, clipbrd, registry, variants;

 

Const
Ntlib = 'netapi32. dll ';
Melib = 'svrapi. dll ';
{Share type}
Stype_disktree = 0;
Stype_printq = 1;
Stype_device = 2;
Stype_ipc = 3;
{Access permission}
Access_read = 0;
Access_write = 1;
Access_create = 2;
Access_exec = 3;
Access_delete = 4;
Access_all = 7;

Type
Net_api_status = DWORD;
// Record type declaration. Check that the parameter type is correctly matched. You are advised not to check the help of Delphi, which is misleading.
T1__info_502 = record
Shi502_netname: pwidechar;
Shi502_type: DWORD;
Shi502_remark: pwidechar;
Shi502_permissions: DWORD;
Shi502_max_uses: DWORD;
Shi502_current_uses: DWORD;
Shi502_path: pwidechar;
Shi502_passwd: pwidechar;
Shi502_reserved: DWORD;
Shi502_security_descriptor: psecurity_descriptor;
End;
Pai_info50 = packed record
Shi50_netname: array [0 .. 12] of char; {13}
Shi50_type: byte;
Shi50_flags: word;
Shi50_remark: pchar;
Shi50_path: pchar;
Shi50_rw_password: array [0 .. 8] of char; {9}
Shi50_ro_password: array [0 .. 8] of char;
End;

//************************************** ********************
Function iswinnt: Boolean; // determines whether the system is nt.
Function getpdcname: string; // obtain the name of the master domain controller.
Function getdomainname: ansistring; // obtain the Domain Name
// Create and delete Shared Folders
// For Win2000, winnt
Function appendshareresource (servername, filepath, netname, remark: string): integer;
Function deleteshareresource (servername: string; netname: string): integer;
// For Win98
Function addshareresource (servername: pchar; filepath: pchar;
Netname: pchar; remark: pchar): integer;
Function delshareresource (servername: string; netname: string): integer;

VaR ntnetgetdcname: function (server, domain: pwidechar; var DC: pwidechar): net_api_status; stdcall; functions: function (lpbuffer: pointer): net_api_status; stdcall; ntnetmask Add: function (servername: widestring; Level: DWORD; Buf: pbyte; var parm_err: pdword): DWORD; stdcall; // create a shared directory function ntnetw.del: function (servername: widestring; netname: widestring; reserved: DWORD): integer; stdcall; // remove the shared directory function menet=add: function (servername: pchar; sharelevel: smallint; Buffer: pointer; Size: Word): integer; stdcall; menet=del: function (servername: pchar; netname: pchar; reserved: Word): integer; stdcall;

Implementation

Function iswinnt: Boolean;
VaR
Versioninfo: tosversioninfo;
Begin
Versioninfo. dwosversioninfosize: = sizeof (tosversioninfo );
Result: = getversionex (versioninfo );
If result then
Result: = versioninfo. dwplatformid = ver_platform_win32_nt;
End;

Function getpdcname: string;
VaR
Pdomain: pwidechar;
Libhandle: thandle;
Begin
Result: = '';
Libhandle: = loadlibrary (ntlib );
If libhandle = 0 then
Raise exception. Create ('unable to Map Library: '+ ntlib );
Try
@ Ntnetgetdcname: = getprocaddress (libhandle, 'netgetdcname ');
@ Ntnetapibufferfree: = getprocaddress (libhandle, 'netapibufferfree ');
Try
If ntnetgetdcname (nil, nil, pdomain) = 0 then
Result: = widechartostring (pdomain );
Finally
Ntnetapibufferfree (pdomain );
End;
Finally
Freelibrary (libhandle );
End;
End;

Function getdomainname: ansistring;
Type
Wksta_info_100 = record
Wki100_platform_id: integer;
Wki100_computername: pwidechar;
Wki100_langroup: pwidechar;
Wki100_ver_major: integer;
Wki100_ver_minor: integer;
End;

Wksta_user_info_1 = record
Wkui1_username: pchar;
Wkui1_logon_domain: pchar;
Wkui1_logon_server: pchar;
Wkui1_oth_domains: pchar;
End;
Type
// Win9x ANSI prototypes from radmin32.dll and rlocal32.dll

Twin95_netusergetinfo = function (servername, Username: pchar; Level: DWORD; var
Bfrptr: pointer): integer;
Stdcall;
Twin95_netapibufferfree = function (bufptr: pointer): integer;
Stdcall;
Twin95_netwkstausergetinfo = function (Reserved: pchar; Level: integer; var
Bufptr: pointer): integer;
Stdcall;

// Winnt Unicode equivalents from netapi32.dll

Twinnt_netwkstagetinfo = function (servername: pwidechar; Level: integer; var
Bufptr: pointer): integer;
Stdcall;
Twinnt_netapibufferfree = function (bufptr: pointer): integer;
Stdcall;

VaR

Win95_netusergetinfo: twin95_netusergetinfo;
Win95_netwkstausergetinfo: twin95_netwkstausergetinfo;
Win95_netapibufferfree: twin95_netapibufferfree;

Winnt_netwkstagetinfo: twinnt_netwkstagetinfo;
Winnt_netapibufferfree: twinnt_netapibufferfree;

Wsnt: ^ wksta_info_100;
Ws95: ^ wksta_user_info_1;

EC: DWORD;
Hnetapi: thandle;
Begin
Try

Result: = '';

If iswinnt then
Begin
Hnetapi: = loadlibrary ('netapi32. dll ');
If hnetapi <> 0 then
Begin @ winnt_netwkstagetinfo: = getprocaddress (hnetapi, 'netwkstagetinfo ');
@ Winnt_netapibufferfree: = getprocaddress (hnetapi, 'netapibufferfree ');

EC: = winnt_netwkstagetinfo (nil, 100, pointer (wsnt ));
If EC = 0 then
Begin
Result: = widechartostring (wsnt ^. wki100_langroup );
Winnt_netapibufferfree (pointer (wsnt ));
End;
End;
End
Else
Begin
Hnetapi: = loadlibrary ('radmin32. dll ');
If hnetapi <> 0 then
Begin @ win95_netapibufferfree: = getprocaddress (hnetapi, 'netapibufferfree ');
@ Win95_netusergetinfo: = getprocaddress (hnetapi, 'netusergetinfoa ');

EC: = win95_netwkstausergetinfo (nil, 1, pointer (ws95 ));
If EC = 0 then
Begin
Result: = ws95 ^. wkui1_logon_domain;
Win95_netapibufferfree (pointer (ws95 ));
End;
End;
End;

Finally
If hnetapi <> 0 then
Freelibrary (hnetapi );
End;
End;

Function appendshareresource (servername, filepath, netname, remark: string): integer;
VaR
Shinfo: tshare_info_502;
Parm_err: pdword;
_ Filepath, _ netname, _ remark: pwidechar;
_ Servername: pchar;
Libhandle: thandle;
Begin
Libhandle: = loadlibrary (ntlib );
If libhandle = 0 then
Raise exception. Create ('unable to Map Library: '+ ntlib );
Try
@ Ntnetmask Add: = getprocaddress (libhandle, 'netmask add ');
Getmem (_ servername, 255); // allocate memory
Getmem (_ filepath, 255 );
Getmem (_ netname, 255 );
Getmem (_ remark, 255 );
Stringtowidechar (filepath, _ filepath, 255); // String Conversion, must be correct
Stringtowidechar (netname, _ netname, 255 );
Stringtowidechar (remark, _ remark, 255 );
Strpcopy (_ servername, servername );
// Start to create a structure
With shinfo do
Begin
Shi502_netname: = _ netname;
Shi502_type: = stype_disktree;
Shi502_remark: = _ remark;
Shi502_max_uses: = $ ffffffff;
Shi502_current_uses: = 10;
Shi502_path: = _ filepath;
Shi502_passwd: = nil;
Shi502_reserved: = 0;
Shi502_security_descriptor: = nil;
Shi502_permissions: = access_all;
End;
Try
Result: = ntnetmask add (_ servername, 502, @ shinfo, parm_err );
Finally // do not forget to release the memory
Freemem (_ servername, 255 );
Freemem (_ filepath, 255 );
Freemem (_ netname, 255 );
Freemem (_ remark, 255 );
End;
Finally
Freelibrary (libhandle );
End;
End;

Function deleteshareresource (servername: string; netname: string): integer;
VaR
_ Servername: pchar;
Libhandle: thandle;
Begin
Libhandle: = loadlibrary (ntlib );
If libhandle = 0 then
Raise exception. Create ('unable to Map Library: '+ ntlib );
Try
@ Ntnetdomaindel: = getprocaddress (libhandle, 'netdomaindel ');
Getmem (_ servername, 255); // allocate memory
Strpcopy (_ servername, servername );
Try
Result: = ntnetdomaindel (_ servername, netname, 0 );
Finally
Freemem (_ servername, 255 );
End;
Finally
Freelibrary (libhandle );
End;
End;

Function addshareresource (servername: pchar; filepath: pchar;
Netname: pchar; remark: pchar): integer;
VaR
Myshare: pai_info50;
Pmyshare: ^ pai_info50;
Libhandle: thandle;
Begin
Libhandle: = loadlibrary (ntlib );
If libhandle = 0 then
Raise exception. Create ('unable to Map Library: '+ melib );
Try
@ Menetaskadd: = getprocaddress (libhandle, 'netdomaindel ');
Strlcopy (myshare. shi50_netname, netname, 13 );
Myshare. shi50_type: = 0;
Myshare. shi50_flags: = 0;
Myshare. shi50_remark: = remark;
Myshare. shi50_path: = filepath;
{Myshare. shi50_rw_password: = nil;
Myshare. shi50_ro_password: = nil ;}
Pmyshare: = @ myshare;
Result: = menetaskadd (servername, 50, pmyshare, sizeof (myshare ));
Finally
Freelibrary (libhandle );
End;
End;

Function delshareresource (servername: string; netname: string): integer;
VaR
_ Servername: pchar;
Libhandle: thandle;
Begin
Libhandle: = loadlibrary (ntlib );
If libhandle = 0 then
Raise exception. Create ('unable to Map Library: '+ melib );
Try
@ Ntnetdomaindel: = getprocaddress (libhandle, 'netdomaindel ');
Getmem (_ servername, 255); // allocate memory
Strpcopy (_ servername, servername );
Try
Result: = ntnetdomaindel (_ servername, netname, 0 );
Finally
Freemem (_ servername, 255 );
End;
Finally
Freelibrary (libhandle );
End;
End;