◇[DELPHI]获取某一计算机上的共享目录
procedure getsharefolder(const computername:string);
var
errcode,a:integer;
netres:array[0..1023] of netresource;
enumhandle:thandle;
enumentries,buffersize:dword;
s:string;
mylistitems:tlistitems;
mylistitem:tlistitem;
mystrings:tstringlist;
begin
with netres[0] do begin
dwscope :=RESOURCE_GLOBALNET;
dwtype :=RESOURCETYPE_DISK;
dwdisplaytype :=RESOURCEDISPLAYTYPE_SHARE;
dwusage :=RESOURCEUSAGE_CONTAINER;
lplocalname :=nil;
lpremotename :=pchar(computername);
lpcomment :=nil;
lpprovider :=nil;
end; // 获取根结点
errcode:=wnetopenenum(RESOURCE_GLOBALNET,RESOURCETYPE_DISK,RESOURCEUSAGE_CONTAINER,@netres[0],enumhandle);
if errcode=NO_ERROR then
begin
EnumEntries:=1024;
BufferSize:=SizeOf(NetRes);
ErrCode:=WNetEnumResource(EnumHandle,EnumEntries,@NetRes[0],BufferSize);
end;
wnetcloseenum(enumhandle);
a:=0;
mylistitems:=controlcenter.lstfile.Items ;
mylistitems.Clear ;
while (string(netres[a].lpprovider)<>”) and (errcode=NO_ERROR) do
begin
with mylistitems do
begin
mylistitem:=add;
mylistitem.ImageIndex :=4;
mylistitem.Caption :=extractfilename(netres[a].lpremotename);
end;
a:=a+1;
end;
end;
◇[DELPHI]得到硬盘序列号
var SerialNum : pdword; a, b : dword; Buffer : array [0..255] of char;
begin
if GetVolumeInformation(‘c:\’, Buffer, SizeOf(Buffer), SerialNum, a, b, nil, 0) then Label1.Caption := IntToStr(SerialNum^);
end;
1.关于MDI主窗体背景新解
在Form中添加Image控件
设BMP图象
name为 IMG_BK
在Foem的Create事件中写入
Self.brush.bitmap:=img_bk.picture.bitmap;
2.在标题栏处画VCL控件(一行解决问题!!!)
在 form 的onpaint 事件中
控件.pointto(getdc(0),left,top);
3 Edit 中只输入数字
SetWindowLong(Edit1.Handle, GWL_STYLE,
GetWindowLong(Edit1.Handle, GWL_STYLE) or
ES_NUMBER);
4.类似MDI方式新解
在要设置child的oncreate方式下写入:
self.parent:=’要设置为mainform的Form’;
5. 屏幕的Refresh(只需一行!)
RedrawWindow(0,nil,0,RDW_ERASE or RDW_INVALIDATE or RDW_ALLCHILDREN);
| |
— —-
handle RGN(可刷新局部屏幕)
6.类似DOS下的CLS指令的WINDOWS指令!
paintdesktop(getdc(0));
7.扩展控件新功能
在编程中 ,我们经常要控制控件的动作,但该控件又没有提供该方法
这时 ,可通过发消息给该控件 ,以达到我们的目的!
如:
button1.perform(wm_keydown,13,0);
listbox1.perform(wm_vscroll,sb_linedown,0);
等等 可少去 重载之苦!!!!!
8.闪烁标题如打印机超时(一行)
form 放一timer 控件
time 事件 中 写入 ;
flashwindow(application.handle,true);
9.在桌面上加个VCL控件!(不是画的,不可refresh)
windows.setparent(控件.handle,0);
注: 想放哪都行 (如’开始处状态栏’)
10.关于 ‘类似MDI方式新解(一行就行!!!!)’的修正
windows.setparent(self.handle,’要设置为mainform的Form’);
11 普通Form象MDI中mainform始终在最底层
SetActiveWindow(0);
或 SetwindowPos(…);
12 执行下列语句开始Windows屏幕保护程序
SendMessage(HWND_BROADCAST,WM_SYSCOMMAND,SC_SCREENSAVE,0);
13 button 的 caption 多行显示：
SetWindowLong(Button1.handle, GWL_STYLE,
GetWindowlong(Button1.Handle, GWL_STYLE) or
BS_MULTILINE);
必要时加上 Button1.Invalidate;
14.整死windows98 🙂
asm int $19 end
Q: 怎么来改变ListBox的字体呢？就修改其中的一行。
A: 先把ListBox1.Style 设成lbOwnerDrawFixed
然后在 OnDrawItem 事件下写下如下代码
procedure TForm1.ListBox1DrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
Offset: Integer;
begin
Offset := 2;
with (Control as TListBox).Canvas do begin
FillRect(Rect);
if Index = 2 then begin
Font.Name := ‘Fixedsys’;
Font.Color := clRed;
Font.Size := 12;
end else begin
Font.Name := ‘Arial’;
Font.Color := clBlack;
Font.Size := 8;
end;
if odSelected in State then begin
Font.Color := clWhite;
end;
TextOut(Rect.Left + Offset, Rect.Top, (Control as TListBox).Items[Index]);
end;
end;
Q：怎么在RichEdit里面插入图片？
A: 请到这里来看看会找到答案
http://www.undu.com/Articles/991107c.html
Q：怎么才能目录呢？
A：我来。
uses ShellAPI;
procedure DeleteFiles(Source: string);
var
FO: TShFileOpStruct;
begin
FillChar(FO,SizeOf(FO),#0);
FO.Wnd := Form1.Handle;
FO.wFunc := FO_DELETE;
FO.pFrom := PChar(Source);
ShFileOperation(FO);
end;
procedure EmptyDirectory(Path: String);
begin
if DirectoryExists(Path) then
begin
DeleteFiles(Path+’\*’);
end
else
ForceDirectories(Path);
end;
Q:如何映射网络驱动器？
比如我要把\\Server\sys映射为F盘。我需要一个函数比如
给出输入参数为\\server\sys\home\bruno给我的返回值是F:\home\bruno
A：
Function UNCToDrive(UNCPath: STring): STring;
var
DriveNum: Integer;
DriveChar: Char;
DriveBits: set of 0..25;
StartSTr,TestStr: STring;
begin
result := UNCPath;
StartSTr := UNCPath;
Integer(DriveBits) := GetLogicalDrives;
for DriveNum := 0 to 25 do
begin
if (DriveNum in DriveBits) then begin
DriveChar := Char(DriveNum + Ord(‘A’));
TestSTr := ExpandUNCFileName(DriveChar+’:\’);
If TEstStr <> ” then
If Pos(Uppercase(TestSTr),Uppercase(STartSTr)) > 0 then
begin
Delete(StartSTr,1,Length(TestSTr));
result := DriveChar+’:\’+StartSTr;
break;
end;
end;
end;
end;
Q：我有一些特殊语言的字体来用，它们存储在我的EXE文件里，但是两点。
* 我不想放到font文件夹里
* 我不想从EXE文件里面提取出来
如果可能，请告诉我。
因为，我的字体是自己做的不是windows自带的，我想保护自己的东西。
A:不太可能，必须提取出来。你可以使用这个保护过程来保护你的文件不被修改和删除。
在EXE执行的时候把字体放到临时文件夹里，结束的时候删除它。
function ProtectFile(sFilename : string) : hFile;
var
hf: hFile;
lwHFileSize, lwFilesize: longword;
ofs : TOFStruct;
begin
if FileExists(sFilename) then
begin
hf := OpenFile(pchar(sFilename), ofs, OF_READ or OF_WRITE or OF_SHARE_EXCLUSIVE);
if hf <> 0 then
begin
lwFilesize := GetFileSize(hf, @lwHFileSize);
if LockFile(hf, 0, 0, lwFilesize, lwHFilesize) then
Result := hf else Result := 0;
end
else Result := 0;
end
else Result := 0;
end;
//..
var
ResS: TResourceStream;
TempPath: array [0..MAX_PATH] of Char;
TempDir: string;
begin
GetTempPath(Sizeof(TempPath), TempPath);
TempDir := StrPas(Path);
ResS := TResourceStream.Create(hInstance, ‘SOME_FONT’, ‘RT_FONT’);
ResS.SavetoFile(TempDir+’some_font.ttf’);
ResS.Free;
AddFontResource(TempDir+’some_font.ttf’);
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
ProtectFile(TempDir+’some_font.ttf’);
end;
Q：如何得到当前的ProgramFiles得路径？
A：用读写注册表的方法就可以做到。
代码如下：
uses registry;
procedure TForm1.Button1Click(Sender: TObject);
var
reg:TRegistry;
begin
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
if reg.OpenKey(‘SOFTWARE\Microsoft\Windows\CurrentVersion’,false) then
begin
edit1.Text:=reg.ReadString(‘ProgramFilesDir’);
reg.CloseKey;
reg.Free;
end;
end;
Q:如何在Jpg图像上写上字？
A：这里有个代码。
hmm, here’s a sample with help of Bitmap, you can chance the brush style of canvas to bsClear to make the text transparent
uses
Jpeg;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp : TBitmap;
Jpg : TJpegImage;
begin
try
Bmp := TBitmap.Create;
Jpg := TjpegImage.Create;
Jpg.LoadFromFile(‘c:\img.jpg’);
Bmp.Assign(Jpg);
Bmp.Canvas.Brush.Style := bsClear;
Bmp.Canvas.Font.Color := clYellow;
Bmp.Canvas.TextOut(10,10,’Hello World’);
Jpg.Assign(Bmp);
Jpg.SaveToFile(‘c:\img2.jpg’);
finally
bmp.Free;
jpg.Free;
end;
end;
Q：怎么用delphi修改文件的时间呢？
在windows下，属性里面有三个日期，创建，修改，存储。我怎么来修改啊？
A：Here is the excerpt from the Jedi Code Library. If it is not complete then get the JCL.
type
// indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelper
TFileTimes = (ftLastAccess, ftLastWrite, ftCreation);
function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean;
var
Handle: THandle;
FileTime: TFileTime;
SystemTime: TSystemTime;
begin
Result := False;
Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil,
OPEN_EXISTING, 0, 0);
if Handle <> INVALID_HANDLE_VALUE then
try
//SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime);
SysUtils.DateTimeToSystemTime(DateTime, SystemTime);
if Windows.SystemTimeToFileTime(SystemTime, FileTime) then
begin
case Times of
ftLastAccess:
Result := SetFileTime(Handle, nil, @FileTime, nil);
ftLastWrite:
Result := SetFileTime(Handle, nil, nil, @FileTime);
ftCreation:
Result := SetFileTime(Handle, @FileTime, nil, nil);
end;
end;
finally
CloseHandle(Handle);
end;
end;
//————————————————————————————————–
function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean;
begin
Result := SetFileTimesHelper(FileName, DateTime, ftLastAccess);
end;
//————————————————————————————————–
function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean;
begin
Result := SetFileTimesHelper(FileName, DateTime, ftLastWrite);
end;
//————————————————————————————————–
function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean;
begin
Result := SetFileTimesHelper(FileName, DateTime, ftCreation);
end;
google上的有关delphi得网址：
http://directory.google.com/Top/Computers/Programming/Languages/Delphi/?tc=1
yahoo上有关delphi得网址
http://dir.yahoo.com/Computers_and_Internet/Programming_and_Development/Languages/Delphi/
删掉程序自己的exe文件
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
var
F:TextFile;
begin
AssignFile(F,’delself.bat’);
Rewrite(F);{F为TextFile类型}
WriteLn(F,’del ‘+ExtractFileName(Application.ExeName));
WriteLn(F,’del %0’); //删除自己delself.bat
CloseFile(F);
WinExec(‘delself.bat’,SW_HIDE);
end;
if ord(s[9])>128 then
ShowMessage(‘该位置字符是汉字’);
汉字是双字节的
更改系统时间格式：
var
str: string;
begin
str := ‘yyyy-mm-dd’;
if SetLocaleInfoa(LOCALE_SYSTEM_DEFAULT, LOCALE_SLONGDATE, PChar(str)) then
begin
showmessage(‘更改日期格式成功’);
end;
end;
休息一分钟：
var
I:integer;
begin
i:=gettickcount;
while (Gettickcount-i)<=10000 do
application.ProcessMessages;//保证消息循环
end;
取主文件名:
function retuFileName(const FileName: string): string;
var
I: Integer;
begin
I := LastDelimiter('.', FileName);
Result := Copy(FileName, 1, i-1);
end;
(1).按下ctrl和其它键之后发生一事件。
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (ssCtrl in Shift) and (key =67) then
showmessage('keydown Ctrl+C');
end;
(2).Dbgrid中用Enter键代替Tab键.
procedure TForm1.DBGrid1KeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
if ActiveControl = DBGrid1 then
begin
TDBGrid(ActiveControl).SelectedIndex := TDBGrid(ActiveControl).SelectedIndex + 1;
Key := #0;
end;
end;
(3).Dbgrid中选择多行发生一事件。
procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
bookmarklist:Tbookmarklist;
bookmark:tbookmarkstr;
begin
bookmark:=adoquery1.Bookmark;
bookmarklist:=dbgrid1.SelectedRows;
try
begin
for i:=0 to bookmarklist.Count-1 do
begin
adoquery1.Bookmark:=bookmarklist[i];
with adoquery1 do
begin
edit;
fieldbyname('mdg').AsString:=edit2.Text;
post;
end;
end;
end;
finally
adoquery1.Bookmark:=bookmark;
end;
end;
(4).Form的一个出现效果。
procedure TForm1.Button1Click(Sender: TObject);
var
r:thandle;
i:integer;
begin
for i:=1 to trunc(width/1.414) do
begin
r:=CreateEllipticRgn(trunc(width/2)-i,trunc(height/2)-i,trunc(width/2)+i,trunc(height/2)+i);
SetWindowRgn(handle,r,true);
Application.ProcessMessages;
sleep(1);
end;
end;
(5).用Enter代替Tab在编辑框中移动隹点。
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
begin
if not (Activecontrol is Tmemo) then
begin
key:=#0;
keybd_event(vk_tab,mapvirtualkey(vk_tab,0),0,0);
end;
end;
end;
(6).Progressbar加上色彩。
const
{$EXTERNALSYM PBS_MARQUEE}
PBS_MARQUEE = 08;
var
Form1: TForm1;
implementation
{$R *.dfm}
uses
CommCtrl;
procedure TForm1.Button1Click(Sender: TObject);
begin
// Set the Background color to teal
Progressbar1.Brush.Color := clTeal;
// Set bar color to yellow
SendMessage(ProgressBar1.Handle, PBM_SETBARCOLOR, 0, clYellow);
end;
(7).住点移动时编辑框色彩不同。
procedure TForm1.Edit1Enter(Sender: TObject);
begin
(sender as tedit).Color:=clred;
end;
procedure TForm1.Edit1Exit(Sender: TObject);
begin
(sender as tedit).Color:=clwhite;
end;
(8).备份和恢复
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
try
adoconnection1.Connected:=False;
adoconnection1.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=FRIEND-YOFZKSCO;'+
'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=FRIEND-YOFZKSCO;Use Encryption for Data=False;Tag with column collation when possible=False';
adoconnection1.Connected:=True;
with adoQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('Backup DataBase sfa to disk ='''+opendialog1.FileName+'''');
ExecSQL;
end;
except
ShowMessage('±?·Y꧰ü');
Exit;
end;
end;
Application.MessageBox('1§?2?ú￡?êy?Y±?·Y3é1|','ìáê?',MB_OK + MB_ICONINFORMATION);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
try
adoconnection1.Connected:=false;
adoconnection1.ConnectionString:='Provider=SQLOLEDB.1;Persist Security Info=False;User ID=sa;Initial Catalog=master;Data Source=FRIEND-YOFZKSCO;'+
'Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=FRIEND-YOFZKSCO;Use Encryption for Data=False;Tag with column collation when possible=False';
adoconnection1.Connected:=true;
with adoQuery1 do
begin
Close;
SQL.Clear;
SQL.Add('Restore DataBase sfa from disk ='''+opendialog1.FileName+'''');
ExecSQL;
end;
except
ShowMessage('???′꧰ü');
Exit;
end;
end;
Application.MessageBox('1§?2?ú￡?êy?Y???′3é1|','ìáê?',MB_OK + MB_ICONINFORMATION);
end;