Uma unit para upload de arquivos em Delphi

var ReqContent:TrwRequestContent; begin ReqContent:= TrwRequestContent.Create(Request); try ReqContent.Field['UserName_fromform'].Content; ReqContent.Field['UploadedFile_fromform'].ContentType; ReqContent.Field['UploadedFile_fromform'].FileName; end; unit ParseRequest; { Copyright ® 2000 Winwright Inc. (Canada) All rights reserved. This unit may be freely used and distributed by anyone for use in any application commercial or otherwise as long as these comments including copyright are kept intact. This unit can be used to parse out data returned from html forms with ENCTYPE="multipart/form-data" and Method=POST Do NOT use on any other encoding. Reason for unit is the TWebRequest class in Delphi does not provide correct handling for multipart data. These helper classes provide this handling. Description: Create an instance of TrwRequestContent passing to the constructor either the complete content from a TWebRequest object or the TWebRequest instance itself. In the latter case TrwRequestContent will take care of making sure all content has been retrieved from the client. TrwRequestContent will first parse the boundary string used to delimit each form item, then use that to parse the content of all the individual fields. For each field parsed, that specific content is passed to the constructor of a TrwRequestItem which then parses it further to pull out the individual elements. For most fields this simply consists of Name and Content. For multi-select listbozes, the content will contain the choices separated by semi-colons (;). For images, the FileName and ContentType properties will also be provided. The Content will be the actual image data and can be directly saved to file as the appropriate type (e.g. .jpg or .gif). Once created, you can iterate the list of names using the FieldName property, individual TrwRequestItems using the Field property, or get the entire TStringList containing the names and TrwRequestItem objects via the Fields property. FieldCount and Contentlength are also available. Freeing the TrwRequestContent object will free all the TrwRequestItem objects. } interface uses Classes, SysUtils, HTTPApp; type { TrwRequestItem: - Contains data about a single item returned from an html form. - There's no need to create these manually, they are created for you by calling the constructor of the TrwRequestContent class. } TrwRequestItem = class private FName: string; FContentType: string; FFileName: string; FContent: string; FContentLength: integer; public constructor Create(const AContent: string); procedure AddValue(const AContent: string); property Name: string read FName; property ContentType: string read FContentType; property FileName: string read FFileName; property Content: string read FContent; property ContentLength: integer read FContentLength; end; { TrwRequestContent: - Passed either the Content property of a TWebRequest class, or an instance of a TWebRequest class, will parse out the individual fields. } TrwRequestContent = class private FList: TStrings; FBoundary: string; FContentLength: cardinal; FContent: string; procedure ClearList; procedure ParseFields(const data: string); function GetFieldCount: integer; function GetField(const index: string): TrwRequestItem; function GetName(index: integer): string; function GetNames: TStrings; public constructor Create(req: TWebRequest); overload; constructor Create(const AData: string); overload; destructor Destroy; override; property ContentLength: cardinal read FContentLength; property Content: string read FContent; property FieldCount: integer read GetFieldCount; property Field[const index: string]: TrwRequestItem read GetField; property FieldName[index: integer]: string read GetName; property FieldNames: TStrings read GetNames; end; implementation const crlf = #13#10; SBoundary = 'boundary='; SFileName = 'filename="'; SName = 'name="'; SContentType = 'Content-Type: '; { TrwContentItem } constructor TrwRequestItem.Create(const AContent: string); // must be passed the data for a single item from the TWebRequest // content. Trailing boundary must be removed. var i, e: integer; begin i := Pos(SName, AContent); if i <= 0 then raise Exception.Create('TrwContentItem: No Name found'); e := Pos('"', pchar(@AContent[i + Length(SName)])); FName := Copy(AContent, i + Length(SName), e-1); i := Pos(SFileName, AContent); if i > 0 then begin e := Pos('"', pchar(@AContent[i + Length(SFileName)])); FFileName := Copy(AContent, i + Length(SFileName), e-1); end; i := Pos(SContentType, AContent); if i > 0 then begin e := Pos(#13, pchar(@AContent[i + Length(SContentType)])); FContentType := Copy(AContent, i + Length(SContentType), e-1); end; i := Pos(crlf + crlf, AContent) + 4; FContentLength := Length(AContent) - i + 1; if FContentLength > 0 then SetString(FContent, pchar(@AContent[i]), FContentLength) else FContent := ''; end; procedure TrwRequestItem.AddValue(const AContent: string); // this allows additional values to be added to an existing // content value for the case of multi-select listboxes. begin FContent := FContent + ';' + AContent; end; { TrwRequestContent } constructor TrwRequestContent.Create(req: TWebRequest); // calling this constructor will check to see if all // data has been retrieved from the client and, if not, // will download it. It will then parse that data. var p: pchar; i: integer; len: cardinal; ms: TMemoryStream; begin FList := TStringList.Create; // get currently retrieved data FContentLength := req.ContentLength; SetString(FContent, pchar(req.Content), Length(req.Content)); SetLength(FContent, FContentLength); len := Length(req.Content); p := pchar(FContent) + len; // get the entire request while len < FContentLength do begin i := req.ReadClient(p^, FContentLength - len); Inc(len, i); Inc(p, i); end; try ms := TMemoryStream.Create; try p := pchar(FContent); ms.Write(p^, len); ms.SaveToFile('c:\\temp\\content.txt'); except ms.Write('Problem', 7); ms.SaveToFile('c:\\temp\\content.txt'); end; finally ms.Free; end; ParseFields(FContent); end; constructor TrwRequestContent.Create(const AData: string); // This constructor assumes you've already correctly // downloaded the entire content from the client. It // simply attempts to parse the passed content begin FList := TStringList.Create; ParseFields(AData); end; procedure TrwRequestContent.ParseFields(const data: string); // this method scans the content and parses out the individual // item blocks (delimited by a boundary string which is the // first parseable item). Each parsed block is passed to the // constructor of the TrwRequestItem class which is added to // the list of items var i, e, idx: integer; item: TrwRequestItem; s: string; begin // get the boundary string i := Pos(crlf, data); FBoundary := Copy(data, 1, i - 1); Inc(i, 2); // parse the request SetString(s, pchar(@data[i]), Length(data) - i); e := Pos(crlf + FBoundary, s); while e > 0 do begin item := TrwRequestItem.Create(Copy(data, i, e - 1)); // need to check for same name in case of multi-select listboxes idx := FList.IndexOf(item.Name); if idx < 0 then // new item (common case) FList.AddObject(item.FName, item) else begin // additional item value TrwRequestItem(FList.Objects[idx]).AddValue(item.Content); item.Free; end; Inc(i, e + Length(FBoundary)); SetString(s, pchar(@data[i]), Length(data) - i); e := Pos(crlf + FBoundary, s); end; end; destructor TrwRequestContent.Destroy; begin ClearList; FList.Free; inherited; end; procedure TrwRequestContent.ClearList; var i: integer; begin for i := 0 to FList.Count - 1 do FList.Objects[i].Free; end; function TrwRequestContent.GetFieldCount: integer; begin Result := FList.Count; end; function TrwRequestContent.GetField(const index: string): TrwRequestItem; // it's assumed you know what fields you are expecting to find // therefore this property is indexed by the name of the field var i: integer; begin i := FList.IndexOf(index); Result := TrwRequestItem(FList.Objects[i]) end; function TrwRequestContent.GetName(index: integer): string; // but if you don't know what names you are expecting, // you can iterate them by number here. begin Result := FList[index] end; function TrwRequestContent.GetNames: TStrings; // this allows access to the TStringList that contains // the field names and TrwRequestItem instances begin Result := FList; end; end.

Quebra-Linha

Colaborador..: Adenilton Rodrigues
Categoria(s).: Delphi;
Data.........: 17/09/2002 18:09:51
Visualizado..: 6330 vezes
Fonte........: http://www.d-tnt.co.uk