function TImageDB.GetAppPath:string;
var
FN: array[0..255] of char;
begin
GetModuleFileName(hInstance,FN,SizeOf(FN));
Result:=ExtractFileDir(FN);
end;
procedure TImageDB.AdaptPictureNameGetImage(Sender: TObject;
Params: TStrings; var MimeType: String; var Image: TStream;
var Owned: Boolean);
var
AppPath:string;
sImagePos:string;
begin
AppPath:=GetAppPath;
sImagePos:=Params.Values['PICTURE_NAME'];
Image:=TFileStream.Create(AppPath+'\Images\'+sImagePos,fmOpenRead);
end;
procedure TImageDB.AdaptPictureNameUploadFile(Sender: TObject;
AFile: TAbstractWebRequestFile);
var
fs:TFileStream;
AppPath:string;
FileExt:string;
begin
if AFile.ContentType = 'image/jpg' then
FileExt:='.jpg'
else if AFile.ContentType = 'image/pjpeg' then
FileExt:='.jpg'
else if AFile.ContentType = 'image/bmp' then
FileExt:='.bmp'
else if AFile.ContentType = 'image/gif' then
FileExt:='.gif'
else FileExt:='';
if FileExt <> '' then
begin
fs:=TFileStream.Create(AppPath+'\Images\'+AdaptName.ActionValue.Values[0]+FileExt,fmCreate);
fs.CopyFrom(AFile.Stream,0);
DataSetAdapter1.DataSet.FieldByName('PICTURE').AsString:=AdaptName.ActionValue.Values[0]+FileExt;
fs.Free;
end;
end;
procedure TImageDB.AdaptPictureNameGetParams(Sender: TObject;
Params: TStrings);
begin
Params.Add('PICTURE_NAME='+AdaptPicture.Value);
end;
procedure TImageDB.AdaptPictureNameValidateFile(Sender: TObject;
AFile: TAbstractWebRequestFile);
begin
if (AFile.ContentType <> 'image/jpg') and
(AFile.ContentType <> 'image/pjpeg') and
(AFile.ContentType <> 'image/bmp') and
(AFile.ContentType <> 'image/gif') then
raise EAdapterException.Create(' 未 知 的 圖 形 格 式 ');
end; |