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<String>;
  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/<ctx>/<nextChunkOffset>
          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/<fileSize>/key/<encodedKey>/fname/<encodedFname>/mimeType/<encodedMimeType>/x:user-var/<encodedUs
    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

相关阅读 >>

Delphi speedbutton按钮动态加载图片(从image和imagelist)

Delphi截取字符串的方法

Delphi 得到一个cuid用户唯一标识

Delphi edit控制字居中,居左,居右

Delphi idhttp控件的防止异常的处理

Delphi里动态创建access的交叉表视图

Delphi kmp(字符串匹配)算法

Delphi 中的颜色

Delphi如何获取句柄?

Delphi 全局变量 hinstance 到底是在什么时候赋值的?

更多相关阅读请进入《Delphi》频道 >>



打赏

取消

感谢您的支持,我会继续努力的!

扫码支持
扫码打赏,您说多少就多少

打开支付宝扫一扫,即可进行扫码打赏哦

分享从这里开始,精彩与您同在

评论

管理员已关闭评论功能...