CopyFile函数拷文件拷不了,,,,不知为什么!在线等待.......... ( 积分: 100 )

  • 主题发起人 主题发起人 meet
  • 开始时间 开始时间
M

meet

Unregistered / Unconfirmed
GUEST, unregistred user!
procedure TMyDataModule.DataModuleCreate(Sender: TObject);
var
WinPath: array [0..255] of Char;
FontPath, AppPath: string;
begin
AppPath := ExtractFilepath(Application.ExeName);
GetWindowsDirectory(WinPath,256);
FontPath := StrPas(WinPath);
CopyFile(PChar(AppPath + '/Font/Wenyuan.TTF'), PChar(FontPath + '/Fonts/Wenyuan.TTF'), False);
end;

我的目的很简单,就是把字体拷到系统字体目录下,代码如上,可这样会在有些系统执行不成功,不知为什么?
后来我就改成以下:
CreateScalableFontResource(0, 'd:/myfont.fot', 'd:/myfont.ttf','d;');
AddFontResource('d:/myfont.fot')

SendMessage(HWM_FONTCHANGE, WND_BROADCAST, 0, 0)

可这样还是不行,,,,一个字体都装安装不上,,,
真是烦,,,,,

再后来我就用InstallShield做了个安装程序,,,,这个是是可以,不知InstallShield是用什么方法,,,,

实在没办法我又试了
procedure TForm1.Button1Click(Sender: TObject);
var
FontFBuf, FontTBuf: array[0..255] of Char;
begin
FillChar(FontFBuf, Sizeof(FontFBuf), 0);
FillChar(FontTBuf, Sizeof(FontTBuf), 0);
StrPCopy(FontFBuf, 'E:/MyFile/Test/DelphiTest/FontFont/IP769292.TTF');
StrPCopy(FontTBuf, 'E:/IP769292.TTF');
try
with FontInfo do
begin
Wnd := Form1.Handle;
wFunc := FO_COPY;
pFrom := FontFBuf;
pTo := FontTBuf;
fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;

SHFileOperation(FontInfo);
except
end;
end;
这个也不行,,老提示无法读源文件或磁盘,,,,真是烦,,,,大虾们这段代码有问题吗?

还请大虾指教,,,,,
 
procedure TMyDataModule.DataModuleCreate(Sender: TObject);
var
WinPath: array [0..255] of Char;
FontPath, AppPath: string;
begin
AppPath := ExtractFilepath(Application.ExeName);
GetWindowsDirectory(WinPath,256);
FontPath := StrPas(WinPath);
CopyFile(PChar(AppPath + '/Font/Wenyuan.TTF'), PChar(FontPath + '/Fonts/Wenyuan.TTF'), False);
end;

我的目的很简单,就是把字体拷到系统字体目录下,代码如上,可这样会在有些系统执行不成功,不知为什么?
后来我就改成以下:
CreateScalableFontResource(0, 'd:/myfont.fot', 'd:/myfont.ttf','d;');
AddFontResource('d:/myfont.fot')

SendMessage(HWM_FONTCHANGE, WND_BROADCAST, 0, 0)

可这样还是不行,,,,一个字体都装安装不上,,,
真是烦,,,,,

再后来我就用InstallShield做了个安装程序,,,,这个是是可以,不知InstallShield是用什么方法,,,,

实在没办法我又试了
procedure TForm1.Button1Click(Sender: TObject);
var
FontFBuf, FontTBuf: array[0..255] of Char;
begin
FillChar(FontFBuf, Sizeof(FontFBuf), 0);
FillChar(FontTBuf, Sizeof(FontTBuf), 0);
StrPCopy(FontFBuf, 'E:/MyFile/Test/DelphiTest/FontFont/IP769292.TTF');
StrPCopy(FontTBuf, 'E:/IP769292.TTF');
try
with FontInfo do
begin
Wnd := Form1.Handle;
wFunc := FO_COPY;
pFrom := FontFBuf;
pTo := FontTBuf;
fFlags := FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;

SHFileOperation(FontInfo);
except
end;
end;
这个也不行,,老提示无法读源文件或磁盘,,,,真是烦,,,,大虾们这段代码有问题吗?

还请大虾指教,,,,,
 
CopyFile(PChar(AppPath + '/Font/Wenyuan.TTF'), PChar(FontPath + '/Fonts/Wenyuan.TTF'), False);
注意第一个
Fonts而不是Font
 
to ak_2005

Font是我建的目录,而不是系统字体目录,,,所以没事,,,
而且我也不想用这种方法,想用API
 
这种方法就是用的API啊
 
to ak_2005
可用CopyFile有些系统不行,,,你有没有其它方法
 
不会吧,那你试试:
uses shellapi

WINSHELLAPI int WINAPI SHFileOperation(

LPSHFILEOPSTRUCT lpFileOp
);
 
我也遇到类似问题,还没有解决呢?
http://www.delphibbs.com/delphibbs/dispq.asp?lid=2894285
强烈关注,帮顶!
 
有些系統執行不成功,是不是因為權限的問題?
 
这和那女的有什么关系

www.coderpub.com
 
楼主,不要文不对题好不好?这是做程序不是做广告,别人进来会怎么想?你站在别人的角度想想,要是想受关注,你把问题提前就可以了。
你让我想起了狼来了的故事,我想喊狼来了的那个小孩也应该长大了吧。你要不高兴,就当我什么也没说。
 
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!!
这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! v这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! v这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!! 这女的也太开放了吧!!!!!!!!!!!!!!!!
 
无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊无聊
 
兄弟们没啥好招啊,,哎,,,急啊,,,,
 
怎么就没人回答吗?
 
复制整个目录及其文件

uses shellapi;
procedure copydirectory(handle:Thandle;fromdir,todir:string);
var
shfileopstruct:Tshfileopstruct;
begin
with shfileopstruct do
begin
wnd:=handle;
wfunc:=fo_copy;
pfrom:=pchar(fromdir);
pto:=pchar(todir);
fFlags:=fof_noconfirmation or fof_renameoncollision;
fanyoperationsaborted:=false;
hnamemappings:=nil;
lpszprogresstitle:=nil;
end;
shfileoperation(shfileopstruct);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
copydirectory(handle,'c:/hyg','d:/');
end;
 
使用直接的Win32API/察看返回值/GetLastError
 
多人接受答案了。
 
后退
顶部