안녕하세요
전 델파이 초보자 입니다
그런데 exe파일에서 dll실행후 exe 파일을 종료하면 run time error발생하는데
해당 프로그램을 수행할시는 발생을 하지 않는데 해당 프로젝트를 종료하면을
error message가 발생합니다 제가 무엇을 잘못했는지요?
이 문제 때문에 몇칠간 고민도 해 보았는데 답을 구할수가 없어서 이곳에
글을 올립니다
꼭 좀 도움좀 주세요
/************************* EXE Source ************************/
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
procedure FileDownLoadCall(var filename,WorkDir,IniFile:String); external 'dfiledow.dll';
implementation
{$R *.DFM}
var
filename,IniFile,WorkDir:String;
procedure TForm1.Button1Click(Sender: TObject);
begin
IniFile := 'materal';
WorkDir := 'c:material';
filename := 'd35a0020.exe';
FileDownLoadCall(filename,WorkDir,iniFile);
WinExec(pchar('c:d_appmateriald35a0020.exe'),0);
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
close;
end;
end.
/************************* DLL Source ************************/
unit pdownlod;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Psock, NMFtp, StdCtrls, ComCtrls,Gauges, FileCtrl;
type
TfDownLod = class(TForm)
NMFTP1: TNMFTP;
Gauge1: TGauge;
Label2: TLabel;
Animate1: TAnimate;
procedure NMFTP1ListItem(Listing: String);
procedure NMFTP1PacketRecvd(Sender: TObject);
procedure DownLoad_call;
procedure MainWork;
procedure Sever_date;
procedure CheckLocalDir(DirName:String);
procedure NMFTP1Disconnect(Sender: TObject);
procedure NMFTP1InvalidHost(var Handled: Boolean);
procedure NMFTP1TransactionStart(Sender: TObject);
procedure NMFTP1Status(Sender: TComponent; Status: String);
procedure NMFTP1Error(Sender: TComponent; Errno: Word; Errmsg: String);
procedure NMFTP1ConnectionFailed(Sender: TObject);
procedure NMFTP1TransactionStop(Sender: TObject);
procedure NMFTP1Failure(var Handled: Boolean; Trans_Type: TCmdType);
procedure NMFTP1Success(Trans_Type: TCmdType);
private
{ Private declarations }
function ConvertDateTime(S:String): TDateTime;
function GettingText(SSS:String; C:Char): String;
function TargetDirectory(SSS,FName:String): String;
public
{ Public declarations }
end;
Const
VERDIR = 'c:Verlist';
DATE_POS = 46; {Server File List에서 날짜 시작점}
MONTH_ENG = 'Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec';
var
fDownLod: TfDownLod;
procedure FileDownLoadCall(var filename,WorkDir,IniFile:string); export;
implementation
{$R *.DFM}
var
S,F : TStringList;
isDownLoad : Boolean;
nFileAge : LongWord;
sSvrFileAge,G_filename,G_IniFile,G_WorkDir : String;
dFileAge,dSvrFileAge : TDateTime;
Size : Longint;
fLocalFile : file of Byte;
nFd, i : integer;
Directory_Check,DLL_CHECk : Boolean; //서버에 해당 File이 있는지 Check
nPos : Word;
procedure FileDownLoadCall(var filename,WorkDir,IniFile:string);
begin
G_filename := filename; G_IniFile := IniFile; G_WorkDir := WorkDir;
isDownLoad := False; DLL_CHECK := False;
fDownLod := TfDownLod.Create(Application);
fDownLod.show;
fDownLod.MainWork;
if fDownLod.NMFTP1.connected then
fDownLod.NMFTP1.Disconnect;
fDownLod.Close;
end;
procedure TfDownLod.NMFTP1Success(Trans_Type: TCmdType);
begin
Case Trans_Type of
cmdChangeDir : Label2.Caption := 'ChangeDir Success';
cmdMakeDir : Label2.Caption := ' cmdMakeDir Success';
cmdDelete : Label2.Caption := ' cmdDelete Success';
cmdRemoveDir : Label2.Caption := ' cmdRemoveDir Success';
cmdList : Label2.Caption := ' cmdList Success';
cmdRename : Label2.Caption := ' cmdRename Success';
cmdUpRestore : Label2.Caption := ' cmdUpRestore Success';
cmdDownRestore : Label2.Caption := ' cmdDownRestore Success';
cmdDownload : Label2.Caption := ' cmdDownload Success';
cmdUpload : Label2.Caption := ' cmdUpload Success';
cmdAppend : Label2.Caption := ' cmdAppend Success';
cmdReInit : Label2.Caption := ' cmdReInit Success';
cmdAllocate : Label2.Caption := ' cmdAllocate Success';
cmdNList : Label2.Caption := ' cmdNList Success';
cmdDoCommand : Label2.Caption := ' cmdDoCommand Success';
end;
end;
procedure TfDownLod.MainWork;
begin
S := TStringList.Create;
F := TStringList.Create;
F.LoadFromFile(VERDIR+''+G_IniFile+'.ini');
if F.count < 6 then
begin
Showmessage('버젼관리파일 오류입니다');
Exit;
end;
NMFTP1.Disconnect;
NMFTP1.Host := GettingText(F.Strings[1],'E');
NMFTP1.UserID := GettingText(F.Strings[3],'E');
NMFTP1.PassWord := GettingText(F.Strings[4],'E');
{FTP Connect}
With NMFTP1 do
if (Host='') or (UserID='') or (PassWord='') then
ShowMessage('서버 접속정보 오류입니다.');
Exit;
try
NMFTP1.Connect;
except
ShowMessage('서버연결이 안됩니다. 잠시후 사용하세요');
Exit;
end;
NMFTP1.ChangeDir(GettingText(F.Strings[2],'E'));
S.Clear;
NMFTP1.list;
//***************************************************************
{Client에 파일 존재여부 Check}
if not FileExists(G_WorkDir+''+G_filename) then
DownLoad_call
else
begin
nFileAge := FileAge(G_WorkDir+''+G_filename); // Client 날짜 Check
dFileAge := FileDateToDateTime(nFileAge);
Sever_date;
if dFileAge <> dSvrFileAge then // Server Vs Client 날짜비교
DownLoad_call;
end;
end;
procedure TfDownLod.Sever_date;
begin
//Server 날짜 Check
For i:=0 to S.Count-1 do
begin
nPos := Pos(G_filename,S.Strings[i]);
if Copy(S.strings[i],nPos,Length(G_filename)) = G_filename then
begin
nPos := Pos(G_filename,S.Strings[i]);
sSvrFileAge := (Copy(S.Strings[i],DATE_POS,nPos-DATE_POS-1));
dSvrFileAge := ConvertDateTime(sSvrFileAge);
DLL_CHECK := TRUE;
end;
end;
end;
procedure TfDownLod.DownLoad_call;
begin
Sever_date;
if DLL_CHECK = TRUE then
begin
Animate1.Visible := True;
Animate1.Active := True;
CheckLocalDir(G_WorkDir); //작업디렉토리검사후 없으면 신규로 생성
Gauge1.Visible := True;
Gauge1.MinValue := 0;
label2.Visible := True;
NMFTP1.Mode(MODE_IMAGE);
NMFTP1.Download(G_filename,G_WorkDir+''+G_filename);
Gauge1.Visible := False;
nFd := _lopen(pChar(G_WorkDir+''+G_filename),OF_WRITE);
FileSetDate(nFd,DateTimeToFileDate(dSvrFileAge));
_lclose(nFd);
Animate1.Active := False;
Animate1.Visible := False;
end
else
begin
showmessage('파일이 Server에 존재하지 않습니다. 전산실로 연락바랍니다');
end;
end;
procedure TfDownLod.NMFTP1ListItem(Listing: String);
begin
S.Add(Listing);
end;
procedure TfDownLod.NMFTP1PacketRecvd(Sender: TObject);
begin
Gauge1.MaxValue := NMFTP1.BytesTotal;
Gauge1.Progress := NMFTP1.BytesRecvd;
label2.Caption := IntToStr(NMFTP1.BytesRecvd) + ' of ' + IntToStr(NMFTP1.BytesTotal);
end;
//Date(영문)을 날짜시간 형식으로 변환
function TfDownLod.ConvertDateTime(S:String):TDateTime;
var
Year,Month,Day,Hour,Min,Sec,MSec : Word;
begin
//File Size가 자리수를 넘는경우
nPos := Pos('',S);
if nPos < 3 then //월자리수Check
Delete(S,1,nPos);
Sec := 0;
MSec := 0;
if (Pos('월',S) > 0) or (Pos('.',S) >0) then
begin
nPos := Pos('월',S);
if nPos > 0 then //MM월 d일 hh:ss
begin
Year := StrToInt(FormatDateTime('YYYY',Now));
Delete(S,nPos,2);
Month := StrToInt(Trim(Copy(S,1,2)));
nPos := Pos('일',S);
Day := StrToInt(Trim(Copy(S,nPos-2,2)));
nPos := Pos(':',S);
Hour := StrToInt(Copy(S,nPos-2,2));
Min := StrToInt(Copy(S,nPos+1,2));
end
else //YYYY.MM.DD
begin
Year := StrToInt(Copy(S,1,4));
Month := StrToInt(Copy(S,6,2));
Day := StrToInt(Copy(S,9,2));
Hour := 12;
Min := 0;
end;
end
else
begin
nPos := Pos(':',S);
if nPos > 0 then //mmm d hh:ss
begin
Year := StrToInt(FormatDateTime('yyyy',Now));
Month := Pos(Copy(S,1,3),Month_ENG) div 4+1;
Day := StrToInt(Trim(Copy(S,5,2)));
Hour := StrToInt(Copy(S,nPos-2,2));
Min := StrToInt(Copy(S,nPos+1,2));
end
else
begin //mmmm d yyyy
Year := StrToInt(Trim(Copy(S,7,5)));
Month := Pos(Copy(S,1,3),Month_ENG) div 4+1;
Day := StrToInt(Trim(Copy(S,5,2)));
Hour := 12;
Min := 0;
end;
end;
Result := EncodeDate(Year,Month,Day) + EncodeTime(Hour,Min,Sec,MSec);
end;
//문자열에서 '='구분자를 찾아 앞(S),뒤(E) 문자열 얻기
function TfDownLod.GettingText(SSS:String; C:Char): String;
begin
nPos := Pos('=',SSS);
Case C of
'S' : Result := Copy(SSS,1,nPos-1);
'E' : Result := Copy(SSS,nPos+1,Length(SSS)-nPos);
end;
if nPos = 0 then
Result := '';
end;
//문자열에서 '='구분자를 찾아 앞문자열의 Directory 얻기
function TfDownLod.TargetDirectory(SSS,FName:String): String;
begin
nPos := Pos('=',SSS);
if FName = Copy(SSS,nPos+1,Length(SSS)-nPos) then
begin
Result := Copy(SSS,1,nPos-1);
Directory_Check := True;
end;
end;
//문자열에서 '='구분자를 찾아 앞문자열의 Directory 얻기
procedure TfDownLod.CheckLocalDir(DirName:String);
begin
if (DirName[Length(DirName)] = '') then
begin
// 문자열의 마지막이 ''표시이면 그 앞부터 처음까지를 DirName변수에 삽입
DirName := Copy(DirName,1,Length(DirName)-1);
end;
if ((Length(DirName)<3) or FileCtrl.DirectoryExists(Dirname)) then
begin
Exit;
end;
{그 앞디렉토리까지만 빼내서 자기자신을 재귀호출한다.
또 디렉토리가 있나 확인한다}
CheckLocalDir(SysUtils.ExtractFilePath(DirName));
try
begin
System.MkDir(DirName);
end;
except
ShowMessage(' Error:<'+G_WorkDir+'> 생성오류');
end;
end;
procedure TfDownLod.NMFTP1Disconnect(Sender: TObject);
begin
Label2.Caption := 'Disconnected';
Close;
end;
procedure TfDownLod.NMFTP1InvalidHost(var Handled: Boolean);
begin
Label2.Caption := 'Invalid Host';
end;
procedure TfDownLod.NMFTP1TransactionStart(Sender: TObject);
begin
Label2.Caption := 'Beginning Data Transfer';
end;
procedure TfDownLod.NMFTP1Status(Sender: TComponent; Status: String);
begin
Label2.caption := Status;
end;
procedure TfDownLod.NMFTP1Error(Sender: TComponent; Errno: Word;
Errmsg: String);
begin
Showmessage('Error '+ IntToStr(Error)+': '+Errmsg);
end;
procedure TfDownLod.NMFTP1ConnectionFailed(Sender: TObject);
begin
Showmessage('Connection Failed');
end;
procedure TfDownLod.NMFTP1TransactionStop(Sender: TObject);
begin
Label2.Caption := 'Data Transfer Complete';
end;
procedure TfDownLod.NMFTP1Failure(var Handled: Boolean;
Trans_Type: TCmdType);
begin
Case Trans_Type of
cmdChangeDir : Label2.Caption := 'ChangeDir Failure';
cmdMakeDir : Label2.Caption := ' cmdMakeDir Failure';
cmdDelete : Label2.Caption := ' cmdDelete Failure';
cmdRemoveDir : Label2.Caption := ' cmdRemoveDir Failure';
cmdList : Label2.Caption := ' cmdList Failure';
cmdRename : Label2.Caption := ' cmdRename Failure';
cmdUpRestore : Label2.Caption := ' cmdUpRestore Failure';
cmdDownRestore : Label2.Caption := ' cmdDownRestore Failure';
cmdDownload : Label2.Caption := ' cmdDownload Failure';
cmdUpload : Label2.Caption := ' cmdUpload Failure';
cmdAppend : Label2.Caption := ' cmdAppend Failure';
cmdReInit : Label2.Caption := ' cmdReInit Failure';
cmdAllocate : Label2.Caption := ' cmdAllocate Failure';
cmdNList : Label2.Caption := ' cmdNList Failure';
cmdDoCommand : Label2.Caption := ' cmdDoCommand Failure';
end;
end;
end.