delphi XE关于微信公众号支付及微信零钱支付的便捷解决方案
https://download.csdn.net/download/pulledup/12683611
一、需求
因为微信公众号支付需要接口开发支持，并且有些小微客户并不希望直接通过微信公众号支付到对公账户或小商户账户进行收单（因为那样会带来不菲的额外“手续费”支出），所以很多用户急切需要一种便捷而低成本的支付方案。
本文主要解决这种需求，以满足多样化的收单需求。
二、实现的效果图示如下
2.1、手机操作
手机App选择支付凭证截屏图片，上传到AppID收单服务器文档数据库，并将相关收单及下次支付信息保存至Sql数据库：
当然，你也可以用个人手机微信生成自己的收款码：
用个人手机微信生成自己的收款码，结果如下：
实际进行支付的人收到分享的收单二维码，长按二维码进行支付：
可以支付给收单方官方微信收款商业版的对公账户或小商户账户（有手续费）：
也可以直接支付给收单方的个人微信零钱：
然后，对手机支付结果界面进行截屏，并点“上传截屏”，选择手机相册中的截屏图片，上传至收单方数据库服务器：
若是电脑端的APP操作，可以通过类似上面，将手机扫码支付或手机转发长按二维码支付后，将支付截屏图片转发给电脑端微信或电脑端QQ后，复制粘贴到电脑端APP：
三、窗体源码如下
unit uZhuce;
interface
uses
System.SysUtils, System.Types, System.UITypes,
System.Classes, System.Variants,System.Actions,
System.Threading,//:系统线程单元,本例用于调用IFuture
System.SyncObjs, //:线程等待的同步对象单元
System.Math,
System.Rtti,
System.Permissions,
FMX.Types, FMX.Controls, FMX.Forms,
FMX.Graphics, FMX.MultiResBitmap,
FMX.Dialogs, FMX.Objects,
FMX.Layouts, FMX.Edit, FMX.Memo,
FMX.ActnList, FMX.StdActns, FMX.MediaLibrary.Actions,
FMX.DialogService,
FMX.Controls.Presentation, FMX.StdCtrls, FMX.ScrollBox,
FMX.ListBox, FMX.Ani,
GYTranslucentStatusAndNavBar,//透明状态栏专用
MySJGY, GY_RestClient, uMyGY_RestClient,
{$IFDEF ANDROID}
Androidapi.Helpers,Androidapi.JNI.Os,//:获取权限申请字符串所需FormCreate
uAndoidCommon,
FMX.Helpers.Android,
{$ENDIF}
FireDAC.Stan.Intf, FireDAC.Stan.Option,
FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
FireDAC.DApt.Intf, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client
;
type
TFormZhuce = class(TForm)
VertScrollBox_01: TVertScrollBox;
Layout_box01: TLayout;
Rectangle_02: TRectangle;
Image_0201: TImage;
Text_0201: TText;
Layout6: TLayout;
Rectangle1: TRectangle;
Text10: TText;
Rectangle2: TRectangle;
Edit_PhoneNumber: TEdit;
ClearEditButton1: TClearEditButton;
Layout2: TLayout;
Rectangle3: TRectangle;
Text11: TText;
Rectangle4: TRectangle;
Edit_Password: TEdit;
ClearEditButton2: TClearEditButton;
StyleBook1: TStyleBook;
Layout_SignIn: TLayout;
Button_SignIn: TRectangle;
Text_SignIn: TText;
Layout3: TLayout;
Rectangle5: TRectangle;
Text12: TText;
Rectangle6: TRectangle;
Edit_PasswordAgain: TEdit;
ClearEditButton3: TClearEditButton;
Layout4: TLayout;
Rectangle7: TRectangle;
Text13: TText;
Rectangle8: TRectangle;
Edit_Verificcode: TEdit;
ClearEditButton4: TClearEditButton;
Rect_Verificcode: TRectangle;
Text_Verificcode: TText;
Rectangle_form: TRectangle;
Text2: TText;
Layout_SignInTipsSuccessAndOther: TLayout;
Rect_SignInTipsSuccess: TRectangle;
Text_SignInTipsSuccess: TText;
Layout_Paying: TLayout;
Rect_Paying: TRectangle;
Text_Paying: TText;
Layout_Paying_Tips: TLayout;
Rect_Paying_Tips: TRectangle;
Text_Paying_Tips: TText;
Rectangle12: TRectangle;
Text6: TText;
Rectangle10: TRectangle;
Text_ProgressVerificcodeNum: TText;
Timer_SignInTipsAndVerificcode: TTimer;
FDMemSmsVerific: TFDMemTable;
Memo1: TMemo;
ImgShare: TImage;
RectLayoutShare: TRectangle;
Layout1: TLayout;
Rect_ShareMeToWeChat: TRectangle;
Text_ShareMeToWeChat: TText;
Rect_ClipBoardGetObjectValue: TRectangle;
Text_Rect_ClipBoardGetObjectValue: TText;
Rectangle14: TRectangle;
Text_ShareMeTop: TText;
Image1: TImage;
Text5: TText;
ActionList1: TActionList;
ShowShareSheetAction1: TShowShareSheetAction;
ImgUpload: TImage;
Layout_ImageShareAndUpload: TLayout;
TakePhotoFromLibraryAction1: TTakePhotoFromLibraryAction;
procedure Image_01MouseEnter(Sender: TObject);
procedure Image_01MouseLeave(Sender: TObject);
procedure Rectangle_grid01MouseEnter(Sender: TObject);
procedure Rectangle_grid01MouseLeave(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Image_0201Click(Sender: TObject);
procedure FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
procedure FormCreate(Sender: TObject);
procedure Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
procedure Button_SignInClick(Sender: TObject);
procedure Rect_VerificcodeMouseEnter(Sender: TObject);
procedure Rect_VerificcodeMouseLeave(Sender: TObject);
procedure Rect_VerificcodeClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Timer_SignInTipsAndVerificcodeTimer(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormShow(Sender: TObject);
procedure ShowShareSheetAction1BeforeExecute(Sender: TObject);
procedure RectLayoutShareClick(Sender: TObject);
procedure RectLayoutShareMouseEnter(Sender: TObject);
procedure RectLayoutShareMouseLeave(Sender: TObject);
procedure Image1MouseEnter(Sender: TObject);
procedure Image1MouseLeave(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure TakePhotoFromLibraryAction1DidFinishTaking(Image: TBitmap);
private
{ Private declarations }
X1, Y1: Single; // 用来判断是否要执行单击事件（记录onmousedown的坐标）
FPermissionCamera, //:拍照所需权限字符串
FPermissionReadExternalStorage,
FPermissionWriteExternalStorage: string;//:媒体库存取所需权限字符串
/// <summary> 验证有效性</summary>
/// <param name=""></param>
/// <param name=""></param>
/// <returns></returns>
function ValidateMe(Sender: TObject):Boolean;
function ValidateMe_Data(Sender: TObject):Boolean;
procedure LoadPicturePermissionRequestResult(Sender: TObject;
const APermissions: TArray<string>;
const AGrantResults: TArray<TPermissionStatus>);
procedure DisplayRationale(Sender: TObject;
const APermissions: TArray<string>; const APostRationaleProc: TProc);
public
{ Public declarations }
closeformname:string; //打开本窗口之后要关闭的窗口名称
IFutureVerificcode, //:未来申请短信验证码
IFutureVerifying //:未来读取并验证短信验证码
: IFuture<string>;
IFutureValueVerificcode, //:未来申请短信验证码的返回标识值
IFutureValueVerifying //:未来读取并验证短信验证码的返回标识值
: string;
end;
var
FormZhuce :TFormZhuce;
FVerificcode :string='';
FAskfordate :string;
FProgressVerificcodeNum :Integer=60;//:UI计时显示秒数
FVerificCodeStrings :TStringList; //:一次性获取到的可能多个短信验证码列表
FImgUploadAssign :Boolean=false; //:加载截屏图片是否完成
FTValueOfImgShare :TValue;//剪切板获取ImgShare官方支付二维码图片的值后返回的泛型值
FNotGrantedPermissions: TArray<String>; //:本窗体申请权限中实际未通过请求的内部权限数组
implementation
{$R *.fmx}
uses
qstring,
uGlobal
//,uTestGYListview1
;
procedure TFormZhuce.Button_SignInClick(Sender: TObject);
begin
showmessage('在这里写注册代码。');
self.Focused:=nil;
end;
procedure TFormZhuce.FormClose(Sender: TObject; var Action: TCloseAction);
begin // 当有调用close时，彻底释放本窗口，如果不需要释放，请注释掉以下2句
Action := TCloseAction.caFree;
if Formzhuce<>nil then Formzhuce := nil;
end;
procedure TFormZhuce.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
Timer_SignInTipsAndVerificcode.Enabled := false;
//:关闭所有与UI相关的Rest线程计时操作
{$IFDEF MSWINDOWS }//Windows下再次防止用户强行中断正在Rest响应数据的应用,否则内存泄漏:
//if DataModuleSqlLiteCommon<>nil then
//DataModuleSqlLiteCommon.DataModuleDestroy(Sender);
if Assigned(IFutureVerifying) then
if IFutureVerifying.Status<>TTaskStatus.Completed then
IFutureVerifying.Wait(3000); //:未来读取并验证短信验证码
if Assigned(IFutureVerificcode) then
if IFutureVerificcode.Status<>TTaskStatus.Completed then
IFutureVerificcode.Wait(500); //:未来申请短信验证码
{$ENDIF}
end;
procedure TFormZhuce.FormCreate(Sender: TObject);
var LPermissions :TArray<String>; //:需要请求的内部权限数组
begin
Layout_Paying_Tips.Visible:=false;//:申请短信的提示文本布局
RectLayoutShare.Visible:=false; //:支付与截屏布局 TCustomBitmapItem
ImgShare.Bitmap:=//:ImgShare.MultiResBitmap中取哪个图片
TBitmap(ImgShare.MultiResBitmap[0].Bitmap as TBitmapOfItem);
TranslucentStatusAndNavBar(self, Rectangle_02); // 将状态栏与导航栏透明显示，顺便做一些每个窗口必须要做的处理
{$IFDEF ANDROID}
// 2 permissions involved: READ_EXTERNAL_STORAGE, WRITE_EXTERNAL_STORAGE
//PermissionsService.RequestPermissions([FPermissionReadExternalStorage, FPermissionWriteExternalStorage],
//LoadPicturePermissionRequestResult, DisplayRationale);
//请求存储权限:
// if TOSVersion.Check(6) then
// begin
// CallInUIThreadAndWaitFinishing(
// procedure
// begin
// LPermissions:=['管理文档','读取文件','写入文件','读手机短信'];
// FNotGrantedPermissions:=nil;
// FNotGrantedPermissions:=
// AndoidRequestPermissions(
// self as TForm,
// LPermissions
// );
// end );
// end;
{$ENDIF}
end;
procedure TFormZhuce.FormKeyUp(Sender: TObject; var Key: Word; var KeyChar: Char; Shift: TShiftState);
begin
if Key = vkHardwareBack then // 如果按了返回键
begin
Key := 0;
Image_0201Click(Sender);
end;
end;
procedure TFormZhuce.FormResize(Sender: TObject);
begin
HideNavBar_GY(self); // 横屏时，将导航栏的北景移动到右边
end;
function NminuteInNowTime(ADatetime:Double; ANminute:Cardinal):string;
var LNowTimeHour :Double;//:某个时间,比如Now或StrToDatetime('2020-07-30 23:41:55.841')
LInteger, LNowTimeDecimal ,LMinute ,LSeceond :Double;
LNminuteInNowTime :Double; LNminute:Cardinal; //:N分钟以内
begin//:ADatetime这个时间为基准ANminute分钟之前以内的时间表达:
LNowTimeHour:=ADatetime;
LInteger:=Trunc(LNowTimeHour); //年月日时
LNowTimeDecimal:=LNowTimeHour-LInteger; //0.N时
LMinute:=LNowTimeDecimal - 60*60/1000/1000; //:mm秒
LSeceond:=LMinute - 60/1000/1000/1000; //:ss毫秒
LNminuteInNowTime:=LInteger + LMinute - ANminute*60/1000/1000;
Result:= FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',LNminuteInNowTime);
end;
function NminuteOutNowTime(ADatetime:Double; ANminute:Cardinal):string;
var LNowTimeHour :Double;//:某个时间,比如Now或StrToDatetime('2020-07-30 23:41:55.841')
LInteger, LNowTimeDecimal ,LMinute ,LSeceond :Double;
LNminuteInNowTime :Double; LNminute:Cardinal; //:N分钟以内
begin
LNowTimeHour:=ADatetime;
LInteger:=Trunc(LNowTimeHour); //年月日时
LNowTimeDecimal:=LNowTimeHour-LInteger; //0.N时
LMinute:=LNowTimeDecimal - 60*60/1000/1000; //:mm秒
LSeceond:=LMinute - 60/1000/1000/1000; //:ss毫秒
LNminuteInNowTime:=LInteger + LMinute + ANminute*60/1000/1000;
Result:= FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',LNminuteInNowTime);
end;
procedure TFormZhuce.FormShow(Sender: TObject);
var LNowTimeHour :Double;//:某个时间,比如Now或StrToDatetime('2020-07-30 23:41:55.841')
LInteger, LNowTimeDecimal ,LMinute ,LSeceond :Double;
LNminuteInNowTime :Double; LNminute:Cardinal; //:N分钟以内
begin
LNminute:=5; //:5分钟以内
LNowTimeHour:=Now;
LInteger:=Trunc(LNowTimeHour); //年月日时
LNowTimeDecimal:=LNowTimeHour-LInteger; //0.N时
LMinute:=LNowTimeDecimal - 60*60/1000/1000; //:mm秒
LSeceond:=LMinute - 60/1000/1000/1000; //:ss毫秒
LNminuteInNowTime:=LInteger + LMinute - LNminute*60/1000/1000;
System.TMonitor.TryEnter(memo1);
memo1.Locked:=true;
memo1.Lines.BeginUpdate;
memo1.Lines.Clear;
memo1.Lines.Add(FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',LNowTimeHour) +',Now= (yyyy-mm-dd hh:nn:ss.zzz) - (yyyy-mm-dd 00:00:00.000) ='+LNowTimeHour.ToString );
memo1.Lines.Add('LInteger=年月日时='+LInteger.ToString);
memo1.Lines.Add('LNowTimeDecimal=分秒毫秒=0.N时='+LNowTimeDecimal.ToString);
memo1.Lines.Add('LMinute=分='+LMinute.ToString);
memo1.Lines.Add('LSeceond=秒毫秒='+LSeceond.ToString);
//LNminuteInNowTime:=LInteger + LMinute - LNminute*60/1000/1000;
memo1.Lines.Add('N分钟以内的时间截='+( LNminuteInNowTime ).ToString );
memo1.Lines.Add('N分钟以内的时间表达='+FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',LNminuteInNowTime) );
memo1.Lines.Add( NminuteInNowTime(LNowTimeHour,5) );
memo1.Lines.Add( NminuteOutNowTime(LNowTimeHour,5) );
memo1.Lines.EndUpdate;
memo1.Locked:=false;
System.TMonitor.Exit(memo1);
end;
procedure TFormZhuce.Image1MouseEnter(Sender: TObject);
begin
TImage(Sender).Opacity := 0.4;
end;
procedure TFormZhuce.Image_0201Click(Sender: TObject);
begin
if Assigned(self.Focused) then // 如果你的该页面有编辑控件，一定要加上这个，按返回键可以去掉键盘框
begin
if ((self.Focused.GetObject is TEdit) or (self.Focused.GetObject is TMemo)) then
begin
self.Focused := nil; // 退出键盘显示
exit;
end;
end;
close;
end;
procedure TFormZhuce.Rectangle1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
X1 := X; // 记录鼠标按下时的坐标值
Y1 := Y;
end;
procedure TFormZhuce.Timer_SignInTipsAndVerificcodeTimer(Sender: TObject);
var LaJson0, LRs0 :string;
LVerificdate :string; //:请求验证码的当前时间毫秒、获取验证码的当前时间毫秒
begin
if Timer_SignInTipsAndVerificcode.Interval<>1000 then
Timer_SignInTipsAndVerificcode.Interval:=1000;
//:UI计时显示秒数及判断网络的时间间隔
system.TMonitor.TryEnter(Text_ProgressVerificcodeNum);
Text_ProgressVerificcodeNum.Locked:=true;
Text_ProgressVerificcodeNum.BeginUpdate;
if FProgressVerificcodeNum>0 then //:UI计时显示秒数
Text_ProgressVerificcodeNum.Text:=TInterlocked.Decrement(FProgressVerificcodeNum).ToString;
Text_ProgressVerificcodeNum.EndUpdate;
Text_ProgressVerificcodeNum.Locked:=false;
system.TMonitor.Exit(Text_ProgressVerificcodeNum);
system.TMonitor.TryEnter(Text_Verificcode);
Text_Verificcode.Locked:=true;
Text_Verificcode.BeginUpdate;
if FProgressVerificcodeNum<=0 then
begin //:UI计时显示秒数
Text_Verificcode.Text:='点击重新获取';
end;
Text_Verificcode.EndUpdate;
Text_Verificcode.Locked:=false;
system.TMonitor.Exit(Text_Verificcode);
{$IF DEFINED(IOS) or DEFINED(ANDROID) or DEFINED(MSWINDOWS)}
//检查网络状态:
if SJGY.GetNetworkState = '0' then
begin
SJGY.ToastConfirm('请打开网络连接', self, 1.5);
//exit;
end;
{$ENDIF}
if FVerificcode.Trim='' then
IFutureVerificcode :=TTask.Future<string>(//:未来申请短信验证码//IFutureValueVerificcode
function: string var LTimer:Cardinal;
begin
TThread.Synchronize(nil,
procedure
begin
FAskfordate :=FormatDateTime('yyyy-mm-dd hh:nn:ss.zzz',Now);
LVerificdate :='';
Text_Paying_Tips.Text:=Text_Paying_Tips.Text.Trim+sLineBreak+FAskfordate;//:测试//////////////////////////
end );
LTimer :=TThread.Current.GetTickCount;
//向短信服务器发送验证码请求：服务器申请获取短消息:表SmsVerificCode：
//Edit_PhoneNumber.Text.trim //:请求短信的手机号
//Fcom_id FSenderPhoneCurrtSmsVerific:string='18190910551';//:当前默认发送短信的Android手机网管
LaJson0 := '{' + sLineBreak
+' "function": "sqlfromstr",' + sLineBreak // 执行sql语句
+' "sql": " '
+' Insert into SmsVerificCode(com_id,PhoneNumber,Askfordate,Verificdate, '
+' Verificcode,[password],SenderPhone) '
+' select top 1 ''001'' as com_id,'''+Edit_PhoneNumber.Text.trim
+''' as PhoneNumber,'''+FAskfordate
+''' as Askfordate,'''+LVerificdate
+''' as Verificdate, '''' as Verificcode, '''+Edit_Password.Text.trim
+''' as password, '''+FSenderPhoneCurrtSmsVerific.trim.trim
+''' as SenderPhone '
+' from SmsVerificCode '
+' where '
+' ( '''
+(Edit_PhoneNumber.Text.trim+FAskfordate+FSenderPhoneCurrtSmsVerific.trim.trim)
+''' not in ( select top 1 ltrim(rtrim(coalesce(a.PhoneNumber,'''')))+ltrim(rtrim(coalesce(a.Askfordate,'''')))+ltrim(rtrim(coalesce(a.SenderPhone,''''))) '
+' from SmsVerificCode a where a.com_id=''001'' and (ltrim(rtrim(coalesce(a.Verificcode,'''')))='''') '
+' order by a.seeds_id ) '
+' ) '
+' ; '
+' " ' //: ;"这个符号非常重要,否则uniDAC不识别单条和多条Sql语句的区别
+'}';
TThread.Synchronize(nil,
procedure
begin
memo1.Lines.Add(LaJson0);//:测试//////////////////////////
end );
//if FDMemSmsVerific.Active=false then
if SQLJson(LaJson0, LRs0, nil) = true then
begin
//TThread.Current.Synchronize(nil,
//procedure
//begin
//任务中不能再嵌套任务,只能嵌套线程:
//end );
end else FProgressVerificcodeNum:=60; //:UI计时显示秒数
IFutureValueVerificcode:=trim(LRs0);
Result:=IFutureValueVerificcode;
end ).Start;
FVerificcode:='YYYYYY';
end;
procedure TFormZhuce.Rect_VerificcodeClick(Sender: TObject);
var
LaJson1, LRs1:string;
LVerifyingCode: string;
begin
Layout_Paying_Tips.Visible:=true;//:申请短信的提示文本布局
//验证有效性:
if (ValidateMe(Sender)=false) then exit;
if (ValidateMe_Data(Sender)=false) then exit;
if (Sender as TRectangle)=Rect_Verificcode then
begin
Text_Paying_Tips.Text:='';
Text_Paying_Tips.Text:=Text_Paying_Tips.Text.Trim+sLineBreak+'开始请求短信验证码';//:测试//////////////////////////
FProgressVerificcodeNum:=20;//:UI计时显示秒数
FVerificcode:=''; Timer_SignInTipsAndVerificcode.Enabled:=false;
Timer_SignInTipsAndVerificcode.Enabled:=true;
end;
if FVerificcode.Trim='' then
begin
Rect_Verificcode.CanFocus:=true; Text_Verificcode.CanFocus:=true;
Rect_Verificcode.HitTest:=true; //Text_Verificcode.HitTest:=true;
Rect_Verificcode.SetFocus;
SJGY.ToastConfirm('请点"获取验证码"', self, 1.5);
exit;
end;
if (FVerificcode<>'')
//and (FVerificCodeStrings.Count>0)
then
begin
if ( (Sender as TRectangle)=Rect_Paying ) then
//or ((Sender as TText)=Text_Paying) then
//:TText放在TRectangle下,不需要HitTest=true,Sender即为其Parent
begin
//开始未任务:读取服务器端被Android短信网关生成的验证码,并比对验证:
LaJson1 := '{' + sLineBreak
+' "function": "sqlfromstr",' + sLineBreak // 执行sql语句
+' "sql": " '
+' select Verificcode '
+' from SmsVerificCode '
+' where com_id=''001'' and (ltrim(rtrim(coalesce(Verificcode,'''')))<>'''') '
+' and ltrim(rtrim(coalesce(PhoneNumber,'''')))='''+Edit_PhoneNumber.Text.trim
+''' and ltrim(rtrim(coalesce(Askfordate,'''')))>='''+NminuteInNowTime( StrToDatetime(FAskfordate.trim),5)
+''' order by seeds_id '
+' ; '
+' " ' //: ;"这个符号非常重要,否则uniDAC不识别单条和多条Sql语句的区别
+'}';
IFutureVerifying:=TTask.Future<string>(//:任务中的线程读取并验证短信验证码//IFutureVerifying
function :string var LTimer1:Cardinal;
begin //FVerificcode
if SQLJson(LaJson1, LRs1, FDMemSmsVerific) = true then
begin
TThread.Current.Synchronize(nil,
procedure
var LCircleFDMemSmsVerific:Integer; //FVerificCodeStrings:TStringList; //:一次性获取到的可能多个短信验证码列表
LVerifyingCodeCount:Integer;
begin
FVerificCodeStrings :=TStringList.Create;
//Memo1.Lines.Clear;
Memo1.Lines.Add(LaJson1);
if FDMemSmsVerific.RecordCount>0 then
begin
FDMemSmsVerific.First;
for LCircleFDMemSmsVerific := 0 to FDMemSmsVerific.RecordCount-1 do
begin
FVerificcode:=FDMemSmsVerific.FieldByName('Verificcode').AsString.Trim;
FVerificCodeStrings.Add(FDMemSmsVerific.FieldByName('Verificcode').AsString.Trim);
Memo1.Lines.BeginUpdate;
//Memo1.Lines.Add(FVerificcode);
Memo1.Lines.Add(FVerificCodeStrings[LCircleFDMemSmsVerific]);
Memo1.Lines.EndUpdate;
if (not FDMemSmsVerific.Eof) then FDMemSmsVerific.Next;
end;
end;
//system.TMonitor.TryEnter(Text_Paying_Tips);
//Text_Paying_Tips.Locked:=true;
Text_Paying_Tips.BeginUpdate;
if not Text_Paying_Tips.Text.Trim.Contains('成功请求5分钟以内的验证码均有效!') then
Text_Paying_Tips.Text:=Text_Paying_Tips.Text.Trim+sLineBreak+'成功请求5分钟以内的验证码均有效!';//:测试//////////////////////////
Text_Paying_Tips.EndUpdate;
//Text_Paying_Tips.Locked:=false;
//system.TMonitor.Exit(Text_Paying_Tips);
if FVerificCodeStrings.Count >0 then
for LVerifyingCodeCount:=0 to FVerificCodeStrings.Count-1 do
begin
LVerifyingCode:=FVerificCodeStrings [ LVerifyingCodeCount ];
if (LVerifyingCode.Trim <> Edit_Verificcode.Text.Trim) then
//if (FVerificcode.Trim <> Edit_Verificcode.Text.Trim) then
begin
SJGY.ToastConfirm('验证码输入错误', self, 1.5);
continue;
end else
begin
Layout_Paying_Tips.Visible:=true;
SJGY.ToastConfirm('验证码通过,请立刻支付后申请注册AppID', self, 1.5);
Break;
end;
end;
FVerificCodeStrings.DisposeOf;
Text_ShareMeTop.Text:='支付与截屏';
Text_Rect_ClipBoardGetObjectValue.Text:='上传截屏';
ImgShare.Bitmap:=//:ImgShare.MultiResBitmap中取哪个图片
TBitmap(ImgShare.MultiResBitmap[0].Bitmap as TBitmapOfItem);
RectLayoutShare.Visible:=true;//:支付与截屏布局显示出来
end );
end;
IFutureValueVerifying:=trim(LRs1);
Result:=IFutureValueVerifying;
end ).Start;
end;
end;
Self.Focused:=nil; //:窗体无焦点就手机不会弹出输入法
end;
procedure TFormZhuce.RectLayoutShareClick(Sender: TObject);
var LTControl,LTControlOfImgShare:TObject;
LTValueOfImgUpload :TValue;//ImgUpload截屏图片复制后的剪切板返回的泛型值
ahost_Old, appid_Old, appkey_Old: string; // 一般在调用窗体的oncreate事件中赋值
ServeAPIName_Old: string; // 虚拟绑定到其它端口如80端口时，在端口后面要用的字符串，在IWServerControllerBaseConfig事件中设置默认为空。在IWServerControllerBaseBind事件中aHttpBindings.Add('http://+:80'+ServeAPIName+'/');
LPermissions: TArray<string>;
LGrantedPermissionsLength ,LNotGrantedPermissionsLength:Integer;
begin
if (Sender as TRectangle)=Rect_ShareMeToWeChat then
begin//:复制到微信
{$IFDEF ANDROID or IOS}//:手机直接拉起并分享到微信
//:直接调用ShowShareSheetAction1:
ShowShareSheetAction1.Execute;
{$ENDIF}
{$IFDEF MSWINDOWS}//:MSWINDOWS复制到微信
//:则调用提示用户请打开微信分享给支付微信号并右键粘贴或如果你直接支付请手机扫码:
ClipBoardGetObjectValue( ImgShare.Bitmap as TObject );
//:前提是设计时已将图片加入到ImgShare.MultiResBitmap[0]
//FTValueOfImgShare:=GetObjectValueFromClipBoard(LTControl);
//if Assigned(LTControl) then LTControl.DisposeOf;
//if not (FTValueOfImgShare.IsEmpty) then Memo1.Lines.Add('not FTValueOfImgShare.IsEmpty');
//Memo1.Lines.Add('剪切板获取ImgShare官方支付二维码图片的值后返回的泛型值'+sLineBreak+FTValueOfImgShare.ToString);
SJGY.ToastConfirm('请打开微信分享给支付微信号并右键粘贴或如果你直接支付请手机微信扫码支付后截屏', self, 10.5);
{$ENDIF}
if ImgUpload.BitMap<>nil then ImgUpload.BitMap:=nil;
ImgShare.Visible:=false;
ImgUpload.Visible:=true;
Text_ShareMeTop.Text:='支付与截屏';
Text_Rect_ClipBoardGetObjectValue.Text:='上传截屏';
end;
if (Sender as TRectangle)=Rect_ClipBoardGetObjectValue then
begin//:上传支付凭证图片
ImgUpload.Align:=TAlignLayout.Fit;//:这个很重要,有了它TImage.BitMap直接Assign二无需考虑TBitmapSuface及Size问题:
if ImgUpload.BitMap<>nil then ImgUpload.BitMap:=nil;
ImgShare.Visible:=false;
ImgUpload.Visible:=true;
{$IFDEF MSWINDOWS} //:若MSWINDOWS直接复制截屏图片
if Text_Rect_ClipBoardGetObjectValue.Text.Trim='上传截屏' then
begin
//if not FClipBoardValue.IsEmpty then begin //:访问冲突 ClipBoardGetObjectValue( nil );//:清空剪切板 end;
FImgUploadAssign:=false;
Text_Rect_ClipBoardGetObjectValue.Text:='粘贴';
//:则调用提示用户请在微信中双击打开打开图片右键复制,然后粘贴于此:
SJGY.ToastConfirm('请在微信中双击打开打开图片右键复制,然后粘贴于此', self, 2.5);
end else
if Text_Rect_ClipBoardGetObjectValue.Text.Trim='粘贴' then
begin
Text_Rect_ClipBoardGetObjectValue.Text:='上传截屏';
SJGY.ToastConfirm('正在上传你截屏的支付凭证,请稍后', self, 2.5);
//执行支付凭证图片上传函数:
try
//if (LTControl=nil) and not (FTValueOfImgShare.IsEmpty) then
begin
LTValueOfImgUpload:=GetObjectValueFromClipBoard(LTControl);
//:LTControl控件引用剪切板对象//:LTValue剪切板返回的泛型值
end;
finally//:注意delphi的剪切板接口服务IFMXClipboardService只能捕获文字或图片,不能剪切文件
//if not (FTValueOfImgShare.IsEmpty) then memo1.Lines.Add('LTValueOfImgShare复制不空'+FTValueOfImgShare.DataSize.ToString);
//if not (LTValueOfImgUpload.IsEmpty) then memo1.Lines.Add('LTValueOfImgUpload截屏不空'+LTValueOfImgUpload.DataSize.ToString);
end;
if (LTControl<>nil) and not (LTValueOfImgUpload.IsEmpty)
//and (LTValueOfImgUpload.DataSize = FTValueOfImgShare.DataSize )//:永远都成立
//and not (LTValueOfImgUpload.GetReferenceToRawData = FTValueOfImgShare.GetReferenceToRawData )//:永远都成立
//and not (FTValueOfImgShare.IsEmpty)
then // and (LTControl is TBitMap)//:这样不行内存泄露要这样:
begin
if LTValueOfImgUpload.IsObject=true
then//如果剪切板返回的泛型值为对象
begin
if LTValueOfImgUpload.ToString.Trim.Contains('TBitmapSurface')=true then
//(TBitmapSurface @ 0BDA80F8)如果运行时剪切板中的内容是图片对象
begin
try
(ImgUpload.BitMap).Assign( TBitMap(LTControl) );
FImgUploadAssign:=true;
finally
SJGY.ToastConfirm('上传完毕', self, 1.5);
end;
end else
begin //Memo1.Lines.Add(LTValueOfImgUpload.ToString);
SJGY.ToastConfirm('复制的不是图片,请重新复制', self, 1.5);
end;
end //else Memo1.Lines.Add(LTValueOfImgUpload.ToString)
;
if Assigned(LTControl) then LTControl.DisposeOf;
//:一定用完后释放剪切板对象否则内存泄漏
end //else Memo1.Lines.Add(LTValueOfImgUpload.ToString) //:剪切板空返回(empty) //}
else if Assigned(LTControl) then LTControl.DisposeOf;//:一定用完后释放剪切板对象否则内存泄漏;//}
;
end;
{$ENDIF}
{$IFDEF ANDROID or IOS} //:若ANDROID or IOS上传截屏图片
FImgUploadAssign:=false;
{$IFDEF ANDROID}
//:请求存储权限:并不包含'管理文档'
//:只需2项权限:READ_EXTERNAL_STORAGE, WRITE_EXTERNAL_STORAGE
//LPermissions:=['管理文档','读取文件','写入文件','读手机短信'];
LPermissions:=['读取文件','写入文件','读手机短信'];
FNotGrantedPermissions:=nil;
FNotGrantedPermissions:=
AndoidRequestPermissions(
(self as TForm),
LPermissions
);
{$ENDIF ANDROID}
{$IFDEF IOS}
( (self as TForm).FindComponent('TakePhotoFromLibraryAction1')
as TTakePhotoFromLibraryAction ).Execute;
//:即:TakePhotoFromLibraryAction1.Execute;
{$ENDIF IOS}
{$ENDIF}
if FImgUploadAssign=true then
begin//:加载截屏图片是否完成:
//SJGY.ToastConfirm('在此写产生CarveoutAppID数据库的UserAppID表信息的代码', self, 1.5);
Text_ShareMeTop.Text:='支付与截屏完成';
//访问正式注册用户的专用服务器前先备份试用版的参数,方便切换:
ahost_Old:=ahost; appid_Old:=appid; appkey_Old:=appkey;
ServeAPIName_Old:=ServeAPIName;
//访问正式注册用户的专用服务器所需的参数:
ahost := 'https://www.cpuofbs.com:8086';
end;
end;
end;
procedure TFormZhuce.Image1Click(Sender: TObject);
begin
ImgShare.Visible:=true;
ImgUpload.Visible:=false;
RectLayoutShare.Visible:=false;//:隐藏布局支付与截屏
end;
procedure TFormZhuce.ShowShareSheetAction1BeforeExecute(Sender: TObject);
begin
//开始分享代码:...{//下面一个动作只能2选1;邮件可以同时分享}
ShowShareSheetAction1.Bitmap.Assign(
ImgShare.Bitmap );
{ if frameCustomDialogsSimple11.MemoShareText.Lines.Text.Trim<>'' then
ShowShareSheetAction1.TextMessage
:=frameCustomDialogsSimple11.MemoShareText.Lines.Text.Trim;
//}
end;
procedure TFormZhuce.TakePhotoFromLibraryAction1DidFinishTaking(Image: TBitmap);
var ScaleFactor: Single;
begin
if Image.Width > 1024 then
begin
ScaleFactor := Image.Width / 1024;
Image.Resize(Round(Image.Width / ScaleFactor), Round(Image.Height / ScaleFactor));
end;
ImgUpload.Bitmap.Assign(Image);
FImgUploadAssign:=true;
end;
procedure TFormZhuce.LoadPicturePermissionRequestResult(
Sender: TObject; const APermissions: TArray<string>;
const AGrantResults: TArray<TPermissionStatus>);
var //:向用户显示请求权限的理由
I: Integer;
NotGrantResultMsg: string;
begin
for I := 0 to High(APermissions) do
begin
if APermissions[I] = FPermissionCamera then
NotGrantResultMsg := NotGrantResultMsg + '您未允许访问手机相机，无法启用相机拍照' + SLineBreak + SLineBreak
else if APermissions[I] = FPermissionReadExternalStorage then
NotGrantResultMsg := NotGrantResultMsg + '您未允许访问手机媒体库，无法保存必要的图片';
end;
// 2 permissions involved: READ_EXTERNAL_STORAGE, WRITE_EXTERNAL_STORAGE
if (Length(AGrantResults) = 2) and
(AGrantResults[0] = TPermissionStatus.Granted) and
(AGrantResults[1] = TPermissionStatus.Granted) then
TakePhotoFromLibraryAction1.Execute
//:授权通过后要执行的事件或过程:这里是打开媒体库供用户选择
else
SJGY.ShowDialog(self, NotGrantResultMsg, '提示信息', '提示', // 调用对话框 aType:提示，输入，选择，编辑共4种
procedure(aResult: Boolean; astr: string) // aStr为空 aResult为true
begin
//
end, TVirtualKeyboardType.Default, $FFF7946F, '确定', '', 3); // 设置了横线颜色,上中下分别对应123,默认值为3
//TDialogService.ShowMessage(RationaleMsg);
end;
// Optional rationale display routine to display permission requirement rationale to the user
procedure TFormZhuce.DisplayRationale(
Sender: TObject; const APermissions: TArray<string>;
const APostRationaleProc: TProc);
var //:向用户显示请求权限的理由
I: Integer;
RationaleMsg: string;
begin
for I := 0 to High(APermissions) do
begin
if APermissions[I] = FPermissionCamera then
RationaleMsg := RationaleMsg + '访问你的手机相机，这样才可以启用相机拍照' + SLineBreak + SLineBreak
else if APermissions[I] = FPermissionReadExternalStorage then
RationaleMsg := RationaleMsg + '访问你的手机媒体库，这样才可以保存必要的图片';
end;
{ // Show an explanation to the user *asynchronously*
//- don't block this thread waiting for the user's response!
// After the user sees the explanation,
//invoke the post-rationale routine to request the permissions
TDialogService.ShowMessage(RationaleMsg,
procedure(const AResult: TModalResult) //等待用户看完上述申请权限的理由
begin
APostRationaleProc; //拉起系统的权限确认
end); //}
//:以上为个性化提示用户的方式,你也可以直接拉起系统的权限确认:
SJGY.ShowDialog(self,
'选择确认后,需要您通过权限提示以便于:'+sLineBreak
+RationaleMsg ,
'请您回答', '选择', // 调用对话框 aType:提示，输入，选择，编辑共4种
procedure(aResult: Boolean; astr: string) // aStr返回输入的内容 aResult返回点击了哪个按钮:true为确定按钮，false为取消按钮
begin
if aResult = true then // 点击了确定按钮
begin
APostRationaleProc;
end;
if aResult = false then // 点击了取消按钮
begin
//
end;
end, TVirtualKeyboardType.Default, $FFF7946F, '确认', '取消', 3); // 设置了横线颜色,上中下分别对应123,默认值为3
end;
function TFormZhuce.ValidateMe(Sender: TObject): Boolean;
var LResult:Boolean; LResultTips:string;
begin//验证数据是否必输:
LResultTips:=''; LResult:=true;
if (LResult=true) and (Edit_PhoneNumber.Text.trim='') then
begin
LResult:=false;
Edit_PhoneNumber.CanFocus:=true; Edit_PhoneNumber.SetFocus;
SJGY.ToastConfirm('手机号必填(找回AppID密码要用它),很重要', self, 1.5);
end;
if (LResult=true) and (Edit_Password.Text.trim='') then
begin
LResult:=false;
Edit_Password.CanFocus:=true; Edit_Password.SetFocus;
SJGY.ToastConfirm('密码必填且请牢记', self, 1.5);
end;
if (LResult=true) and (Edit_PasswordAgain.Text.trim='') then
begin
LResult:=false;
Edit_PasswordAgain.CanFocus:=true; Edit_PasswordAgain.SetFocus;
SJGY.ToastConfirm('请再次确认密码', self, 1.5);
end;
if LResult=false then
begin
Result:=false;
end else
begin
Result:=true;
end;
end;
function TFormZhuce.ValidateMe_Data(Sender: TObject): Boolean;
var LResult:Boolean; LResultTips:string; LPhoneNumber:string;
begin//验证数据的完整性和一致性:
LResultTips:=''; LResult:=true;
if (LResult=true) and (Edit_PhoneNumber.Text.trim<>'') then
begin
if IsChineseMobile(Edit_PhoneNumber.Text.trim)=false then
begin
LResult:=false;
Edit_PhoneNumber.CanFocus:=true; Edit_PhoneNumber.SetFocus;
SJGY.ToastConfirm('必须是有效的11位中国手机号！', self, 1.5);
end;
end;
if (LResult=true) and (Edit_Password.Text.trim<>'') then
begin
if (Length(Edit_Password.Text.trim)<8) or
(Length(Edit_Password.Text.trim)>16) then
begin
LResult:=false;
Edit_Password.CanFocus:=true; Edit_Password.SetFocus;
SJGY.ToastConfirm('请输入8~16位密码', self, 1.5);
end;
end;
if (LResult=true) and (Edit_PasswordAgain.Text.trim<>'') then
begin
if (Edit_PasswordAgain.Text.trim
<> Edit_Password.Text.trim) then
begin
LResult:=false;
Edit_PasswordAgain.CanFocus:=true; Edit_PasswordAgain.SetFocus;
SJGY.ToastConfirm('两次输入的密码不吻合,请重新输入', self, 1.5);
end;
end;
if LResult=false then
begin
Result:=false;
end else
begin
Result:=true;
end;
end;
procedure TFormZhuce.Rect_VerificcodeMouseEnter(Sender: TObject);
begin
TRectangle(Sender).Opacity:=0.5;
end;
procedure TFormZhuce.Rect_VerificcodeMouseLeave(Sender: TObject);
begin
TRectangle(Sender).Opacity:=1;
end;
procedure TFormZhuce.Rectangle_grid01MouseEnter(Sender: TObject);
begin
TRectangle(Sender).Fill.Color := $FF8BD2ED;
end;
procedure TFormZhuce.Rectangle_grid01MouseLeave(Sender: TObject);
begin
TRectangle(Sender).Fill.Color := $FF18B4ED;
end;
procedure TFormZhuce.RectLayoutShareMouseEnter(Sender: TObject);
begin
TRectangle(Sender).Fill.Color := $FF8BD2ED;
end;
procedure TFormZhuce.RectLayoutShareMouseLeave(Sender: TObject);
begin
TRectangle(Sender).Fill.Color := $FF18B4ED;
end;
procedure TFormZhuce.Image1MouseLeave(Sender: TObject);
begin
TImage(Sender).Opacity := 1;
end;
procedure TFormZhuce.Image_01MouseEnter(Sender: TObject);
begin
TImage(Sender).Opacity := 0.4;
end;
procedure TFormZhuce.Image_01MouseLeave(Sender: TObject);
begin
TImage(Sender).Opacity := 1;
end;
initialization
finalization
end.附：本博客相关文章文章：
《delphi XE开发微信支付时所需的Android获取手机存储权限、Android获取短信权限》
https://blog.csdn.net/pulledup/article/details/107773589
喜欢的话，就在下面点个赞、收藏就好了，方便看下次的分享：