⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 uupphoto.pas

📁 关于利用DELPHI来进行企业级方案解决的著作的附书源码
💻 PAS
字号:

unit uUpPhoto;

interface

uses
  Windows, Messages, SysUtils, Classes, HTTPApp, WebModu, HTTPProd,
  WebAdapt, WebComp;

type
  TUpPhoto = class(TWebPageModule)
  PageProducer: TPageProducer;
    UploadAdapter: TAdapter;
    Upload: TAdapterAction;
    UploadedFiles: TStringsValuesList;
    UploadFile: TAdapterFileField;
    procedure UploadExecute(Sender: TObject; Params: TStrings);
    procedure WebPageModuleActivate(Sender: TObject);
    procedure UploadFileUploadFiles(Sender: TObject;
      Files: TUpdateFileList);
  private
    function GetBaseDirectory: string;
  public
    { Public declarations }
  end;

  function UpPhoto: TUpPhoto;

implementation

{$R *.dfm}  {*.html}

uses WebReq, WebCntxt, WebFact, Variants, SiteComp, FileCtrl, 
  WebUsers, AdaptReq, wdmDB;

resourcestring
  rNoFilesUploaded = '没有选择上载图片文件!';
  rMoreFilesUploaded = '上载文件太多,只能选择一个文件!';
  rRequireJpeg = '必须使用JPG格式(扩展名为.jpg)文件';
  rNoUploadFileFound = '找不到上载文件,请检查是否选择了上载图片文件?';
  rUploadPageTitle = '上载照片';

function UpPhoto: TUpPhoto;
begin
  Result := TUpPhoto(WebContext.FindModuleClass(TUpPhoto));
end;

function TUpPhoto.GetBaseDirectory: string;
begin
  Result := ExtractFilePath(GetModuleName(HInstance));
end;

procedure TUpPhoto.UploadExecute(Sender: TObject;
  Params: TStrings);
begin
  UploadAdapter.UpdateRecords;
end;

procedure TUpPhoto.WebPageModuleActivate(Sender: TObject);
begin
  UploadedFiles.Strings.Clear;
end;

procedure TUpPhoto.UploadFileUploadFiles(Sender: TObject;
  Files: TUpdateFileList);
var
  FileStream: TFileStream;
begin
  if Files.Count <= 0 then
    raise Exception.Create(rNoFilesUploaded);
  if Files.Count >1 then
    raise Exception.Create(rMoreFilesUploaded);
     // 确保使用JPG格式(扩展名为.jpg)文件
  if (CompareText(ExtractFileExt(Files.Files[0].FileName), '.jpg') <> 0) then
  begin
      UploadAdapter.Errors.AddError(rRequireJpeg);
  end else
  begin
 // 将文件保存到数据库中

   { ForceDirectories(GetBaseDirectory + 'users\' + CurrentUser);
      FileStream := TFileStream.Create(GetBaseDirectory + 'users\' +
        CurrentUser + '\' + ExtractFileName(Files.Files[0].FileName),
        fmCreate or fmShareDenyWrite);

      try
        FileStream.CopyFrom(Files.Files[0].Stream, 0); // 0 = copy all from start
        // Set the name/value pair as FileName=Size
        UploadedFiles.Strings.Values[ExtractFileName(Files.Files[I].FileName)]
          := IntToStr(FileStream.Size);
      finally
        FileStream.Free;
      end;  } 
  end;
end;

initialization
  if WebRequestHandler <> nil then
    WebRequestHandler.AddWebModuleFactory(TWebPageModuleFactory.Create(TUpPhoto,
      TWebPageInfo.Create([wpPublished, wpLoginRequired], '.html', '', rUploadPageTitle),
      crOnDemand, caCache));

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -