delphi 上传文件到七牛，纯原生
纯Delphi 原生写的 上传到七牛的功能。
上传文件到七牛， 支持分片分段上传， 适用于Delphi XE, 10等新版本
分两个函数： uploadToQiniu 和 directUploadToQiniu
uploadToQiniu 这个函数使用分片， 分段的方式上传， 并有上传进度回调， 采用多线程同时进行, 该方法适用于上传较大文件。
directUploadToQiniu 该函数直接使用Form表单的形式上传， 没有上传进度回调， 适用于上传较小的文件。
unit qiniu;
interface
type
TNwUploadToQiniuStatus = (uqsUploaded, uqsUploadFail, uqsFileNotExists, uqsHttpNoneOK);
TNwUpQiniuProgressCallback = reference to procedure(p: integer);
function uploadToQiniu( filename, token, key:string; progress:TNwUpQiniuProgressCallback ):TNwUploadToQiniuStatus;
function directUploadToQiniu( filename, token, key:string ):TNwUploadToQiniuStatus;
implementation
uses System.Net.HttpClient, System.Classes,System.Net.Mime, System.SysUtils,
system.Net.URLClient, Winapi.Windows, CommonFunction, System.Math, System.JSON,
System.netencoding, System.threading,SyncObjs;
function directUploadToQiniu( filename, token, key:string ):TNwUploadToQiniuStatus;
var
http: THttpClient;
data:TMultipartFormData;
response:IHTTPResponse;
content:string;
begin
if not FileExists(filename) then
begin
Exit(uqsFileNotExists);
end;
Result := uqsUploadFail;
http := THTTPClient.Create;
data := TMultipartFormData.Create();
try
data.AddField('token', token);
data.AddField('key', key);
data.AddField('fileName', ExtractFileName(filename));
data.AddFile('file', filename);
response := http.Post('http://up-z2.qiniu.com/', data, nil);
if response.StatusCode = 200 then
begin
Result := uqsUploaded;
end
else
WinAPI.windows.OutputDebugString(PChar(Format('upload file:%s fail: %s, key: %s', [filename, response.ContentAsString(), key])));
finally
http.Free;
data.Free;
end;
end;
function uploadToQiniu( filename, token, key:string; progress:TNwUpQiniuProgressCallback ):TNwUploadToQiniuStatus;
const
blocksize = 4*1024*1024;
chunksize = 500*1024;
var
filesize, blocks, okChuncks, chuncks:Cardinal;
http: THttpClient;
data:TBytesStream;
response:IHTTPResponse;
host,content:string;
header:TNetHeaders;
fileStream:TFileStream;
responseValue:TJSonObject;
ctxs:TArray;
lock:TCriticalSection;
begin
if not FileExists(filename) then
begin
Exit(uqsFileNotExists);
end;
filesize := GetFileSize(filename);
if filesize < 10*1024*1024 then
begin
Result := directUploadToQinu(filename, token, key );
exit;
end;
blocks := Floor(filesize/blocksize);
chuncks := Floor (filesize/chunksize);
okChuncks := 0;
host := 'http://up-z2.qiniup.com';
Result := uqsUploadFail;
http := THTTPClient.Create;
data := TBytesStream.Create();
insert(TNameValuePair.Create('Authorization', 'UpToken '+token), header, High(header));
SetLength(ctxs, blocks+1);
fileStream := TFileStream.Create(filename, fmShareDenyWrite or fmOpenRead);
lock := TCriticalSection.Create;
try
TParallel.&For(0, blocks, procedure(Idx:Integer)
var
offset, currentChunkSize, currentBlockSize:Cardinal;
data1:TBytesStream;
lastCtx:string;
http1: THttpClient;
begin
WinAPI.windows.
OutputDebugString(PChar(Format('uploading block idx: %d', [Idx])));
data1 := TBytesStream.Create();
http1 := THTTPClient.Create;
try
offset := 0;
currentBlockSize := Min(filesize-idx*blocksize, blocksize);
//开始分片上传
///bput//
while offset < currentBlockSize do
begin
data1.Clear;
lock.Acquire;
try
filestream.Seek(idx*blocksize+offset, TSeekOrigin.soBeginning);
currentChunkSize := Min(chunksize, currentBlockSize-offset);
data1.CopyFrom(fileStream, currentChunkSize);
finally
lock.Release;
end;
//创建第一个块
data1.Seek(0, TSeekOrigin.soBeginning);
if offset = 0 then
response := http1.Post(Format('%s/mkblk/%d', [host, currentBlockSize]), data1,nil, header)
else
response := http1.Post(Format('%s/bput/%s/%d', [host,lastCtx,offset]), data1,nil, header);
if response.StatusCode = 200 then
begin
responseValue := TJSonObject.ParseJSONValue(response.ContentAsString(TEncoding.UTF8)) as TJSonObject;
lastCtx := responseValue.GetValue('ctx').Value;
end
else
Exit;
inc(offset, currentChunkSize);
inc(okChuncks);
if Assigned(progress) then
progress(Min(100, Round(okChuncks*100/chuncks)));
end;
ctxs[idx] := lastCtx;
finally
data1.Free;
http1.Free;
end;
end);
//合并文件
///mkfile//key//fname//mimeType//x:user-var/
data.Clear;
with TStringStream.Create(''.Join(',', ctxs)) do begin
SaveToStream(data);
free;
end;
data.Seek(0, TSeekOrigin.soBeginning);
// use content to store encoded key
content := TBase64Encoding.Base64.Encode(key).Replace('+', '-').Replace('/', '_');
response := http.Post(Format('%s/mkfile/%d/key/%s', [host, filesize, content]), data,nil, header);
if response.StatusCode = 200 then
Result := TNwUploadToQiniuStatus.uqsUploaded;
finally
http.Free;
data.Free;
fileStream.Free;
lock.Free;
end;
end;
end.
来源：https://github.com/Neugls/uploadtoqiniu/blob/master/qiniu.pas
推荐分享
图文皆来源于网络，内容仅做公益性分享，版权归原作者所有，如有侵权请告知删除！
Copyright © 2014 DelphiW.com 开发 源码 文档 技巧 All Rights Reserved
晋ICP备14006235号-8 晋公网安备 14108102000087号
执行时间: 0.041743993759155 seconds