webpagelookmod.pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

  begin
    Name := cSavedPicsPerPage;
    Value := IntToStr(PicturesIterator.PageSize);
    Path := WebContext.Request.InternalScriptName;
  end;
end;

procedure TWebPageLookModule.SavedThumbWidthGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := FThumbWidth;
end;

procedure TWebPageLookModule.SavedColNumberGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := FPicsPerRow;
end;

procedure TWebPageLookModule.MaxCountOldGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := FPictureList.Count;
end;

procedure TWebPageLookModule.NewPicturePageExecute(Sender: TObject;
  Params: TStrings);
begin
  try
    //jmt.!!! FStartAtIndex := StrToInt(Params.Values['index']);
  except
    on E: Exception do PicturesIterator.Errors.AddError(E);
  end;
end;

procedure TWebPageLookModule.DeletePictureGetParams(Sender: TObject;
  Params: TStrings);
begin
  Params.Values['filename'] := ExtractFileName(FPictureList[FCurrentIndex]); 
end;

procedure TWebPageLookModule.DeletePictureExecute(Sender: TObject;
  Params: TStrings);
var
  FileName, UserName: string;
begin
  try
    // NOTE: HttpDecode should be done for us!
    FileName := HttpDecode(Params.Values['filename']);
    if FileName <> '' then
    begin
      UserName := MainPageModule.GetCurrentUserName;
      if UserName <> '' then
      begin
        // Delete the actual file
        DeleteFile(ExtractFilePath(GetModuleName(HInstance)) +
          'users\' + UserName + '\' + FileName);
      end;
    end;
  except
    on E: Exception do PicturesIterator.Errors.AddError(E);
  end;
end;

procedure TWebPageLookModule.PicturesIteratorIterateRecords(
  Sender: TObject; Action: TIteratorMethod; var EOF: Boolean);
begin
  case Action of
   itStart:
     EOF := not PicturesIteratorStartIterator;
   itNext:
     EOF := not PicturesIteratorNextIteration;
   itEnd:
     FCurrentIndex := 0;
  end;
end;

procedure TWebPageLookModule.PictureImageGetParams(Sender: TObject;
  Params: TStrings);
begin
  Params.Values['filename'] := ExtractFileName(FPictureList[FCurrentIndex]);
end;

procedure TWebPageLookModule.PictureImageGetImage(Sender: TObject;
  Params: TStrings; var MimeType: String; var Image: TStream;
  var Owned: Boolean);
var
  UserName: string;
  FileStream: TFileStream;
begin
  try
    if Params.Values['filename'] <> '' then
    begin
      UserName := MainPageModule.GetCurrentUserName;
      if UserName <> '' then
      begin
        FileStream := TFileStream.Create(ExtractFilePath(GetModuleName(HInstance)) +
          'users\' + UserName + '\' + HttpDecode(Params.Values['filename']),
          fmOpenRead or fmShareDenyWrite);
        MimeType := 'image/jpeg'; { do not localize }
        Image := FileStream;
        Owned := True;
      end
      else
        raise Exception.Create(rNotLoggedIn);
    end
    else
      raise Exception.Create(rNoFilenameGiven);
  except
    on E: Exception do PicturesIterator.Errors.AddError(E);
  end;
end;

procedure TWebPageLookModule.PictureThumbImageGetImage(Sender: TObject;
  Params: TStrings; var MimeType: String; var Image: TStream;
  var Owned: Boolean);
var
  Jpeg: TJpegImage;
  UserName: string;
  Stream: TMemoryStream;
  ThumbPicture: TBitmap;
begin
  try
    if Params.Values['filename'] <> '' then
    begin
      UserName := MainPageModule.GetCurrentUserName;
      if UserName <> '' then
      begin
        Jpeg := TJpegImage.Create;
        try
          Jpeg.LoadFromFile(ExtractFilePath(GetModuleName(HInstance)) +
            'users\' + UserName + '\' + HttpDecode(Params.Values['filename']));

          // Resize it to be a thumbnail
          ThumbPicture := TBitmap.Create;
          try
            if FThumbWidth > Jpeg.Width then
              FCurrentWidth := Jpeg.Width
            else
              FCurrentWidth := FThumbWidth;

            ThumbPicture.Width := FCurrentWidth;
            ThumbPicture.Height := Trunc(FCurrentWidth * (Jpeg.Height / Jpeg.Width));

            ThumbPicture.Canvas.StretchDraw(Rect(0, 0,
              ThumbPicture.Width-1, ThumbPicture.Height-1), Jpeg);
            Jpeg.Assign(ThumbPicture);
          finally
            ThumbPicture.Free;
          end;
          Stream := TMemoryStream.Create;
          Jpeg.SaveToStream(Stream);
          MimeType := 'image/jpeg'; { do not localize }
          Stream.Position := 0;
          Image := Stream;
          Owned := True;
        finally
          Jpeg.Free;
        end;
      end
        else raise Exception.Create(rNotLoggedIn);
    end
      else raise Exception.Create(rNoFileNameGiven);
  except
    on E: Exception do PicturesIterator.Errors.AddError(E);
  end;
end;

procedure TWebPageLookModule.PictureImageGetImageName(Sender: TObject;
  var Value: String);
begin
  try
    Value := ExtractFileName(FPictureList[FCurrentIndex]);
  except
    on E: Exception do
    begin
      PicturesIterator.Errors.AddError(E);
      Value := Unassigned;
    end;
  end;
end;

procedure TWebPageLookModule.PicturesIteratorGetFirstRecord(
  Sender: TObject; var EOF: Boolean);
begin
   EOF := not PicturesIteratorStartIterator;
end;

procedure TWebPageLookModule.PicturesIteratorGetNextRecord(Sender: TObject;
  var EOF: Boolean);
begin
  EOF := not PicturesIteratorNextIteration;
end;

procedure TWebPageLookModule.PicturesIteratorGetRecordCount(
  Sender: TObject; var Count: Integer);
begin
  Count := FPictureList.Count;
end;

procedure TWebPageLookModule.PicturesIteratorGetRecordIndex(
  Sender: TObject; var Index: Integer);
begin
  Index := FCurrentIndex;
end;

procedure TWebPageLookModule.PicturesIteratorGetEOF(Sender: TObject;
  var EOF: Boolean);
begin
  EOF := FCurrentIndex >= FPictureList.Count;
end;

procedure TWebPageLookModule.MaxPicsPerPageGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := PicturesIterator.PageSize;
end;

procedure TWebPageLookModule.SubmitOptionsExecute(Sender: TObject;
  Params: TStrings);
var
  Value: IActionFieldValue;
begin
  try
    Value := PreferredThumbWidth.ActionValue;
    if Assigned(Value) then
      FThumbWidth := StrToInt(Value.Values[0]);
  except
    on E: Exception do
    begin
      DisplayOptions.Errors.AddError(E);
      PreferredThumbWidth.EchoActionFieldValue := True;
    end;
  end;
  try
    Value := MaxPicsPerRow.ActionValue;
    if Assigned(Value) then
    begin
      FPicsPerRow := StrToInt(Value.Values[0]);
      if FPicsPerRow <= 0 then
        FPicsPerRow := cDefaultCols;
    end;
  except
    on E: Exception do
    begin
      DisplayOptions.Errors.AddError(E);
      MaxPicsPerRow.EchoActionFieldValue := True;
    end;
  end;
  try
    Value := MaxPicsPerPage.ActionValue;
    if Assigned(Value) then
    begin
      PicturesIterator.PageSize := StrToInt(Value.Values[0]);
      if PicturesIterator.PageSize < 0 then
        PicturesIterator.PageSize := cDefaultPicsPerPage;
    end;
  except
    on E: Exception do
    begin
      DisplayOptions.Errors.AddError(E);
      MaxPicsPerPage.EchoActionFieldValue := True;
    end;
  end;
end;

procedure TWebPageLookModule.PreferredThumbWidthGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := FThumbWidth;
end;

procedure TWebPageLookModule.MaxPicsPerRowGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := FPicsPerRow;
end;

procedure TWebPageLookModule.PicsPerRowGetValue(Sender: TObject;
  var Value: Variant);
begin
  Value := FPicsPerRow;
end;

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