f_mailto.srf 2.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127
  1. $PBExportHeader$f_mailto.srf
  2. global type f_mailto from function_object
  3. end type
  4. forward prototypes
  5. global function integer f_mailto (string arg_mailaddress, string arg_title, string arg_content, ref string arg_msg)
  6. end prototypes
  7. global function integer f_mailto (string arg_mailaddress, string arg_title, string arg_content, ref string arg_msg);int rslt = 1
  8. uo_email obj_email
  9. obj_email = create uo_email
  10. if not f_hasDotNet() then
  11. rslt = 0
  12. arg_msg = '如需收发邮件请安装.net2.0!'
  13. goto ext
  14. end if
  15. transaction commit_tran
  16. transaction fj_tran
  17. s_email_send s_send
  18. s_email_sendmx s_sendmx[]
  19. s_email_lvfj s_lvfj[]
  20. commit_tran = sqlca
  21. Long ll_ConnectionID
  22. IF f_get_outerconnection_email(ll_ConnectionID,arg_msg) = 1 THEN
  23. fj_tran = sys_email_sqlca
  24. ELSE
  25. rslt = 0
  26. arg_msg = '要使用邮件功能,请先定义邮件数据库'
  27. goto ext
  28. END IF
  29. obj_email.commit_tran = commit_tran
  30. obj_email.fj_tran = fj_tran
  31. long ll_cnt
  32. Select COUNT(0) INTO :ll_cnt
  33. from u_email_set where empid = :sys_empid and mailtype = 0;
  34. if sqlca.sqlcode <> 0 then
  35. rslt = 0
  36. arg_msg = '查询邮箱设置失败,' + sqlca.sqlerrtext
  37. goto ext
  38. end if
  39. if ll_cnt <= 0 then
  40. rslt = 0
  41. arg_msg = '没有定义邮箱帐号'
  42. goto ext
  43. end if
  44. select top 1 mailid, mailuser, mailaddress
  45. INTO :s_send.mailid, :s_send.senduser, :s_send.sendaddress
  46. from u_email_set
  47. where empid = :sys_empid and mailtype = 0;
  48. if sqlca.sqlcode <> 0 then
  49. rslt = 0
  50. arg_msg = '查询邮箱设置失败,' + sqlca.sqlerrtext
  51. goto ext
  52. end if
  53. s_send.mailaddress = s_send.sendaddress
  54. select top 1 boxid
  55. INTO :s_send.boxid
  56. from u_email_box
  57. where mailid = :s_send.mailid and boxtype = '发件箱';
  58. if sqlca.sqlcode <> 0 then
  59. rslt = 0
  60. arg_msg = '查找发件箱失败'
  61. goto ext
  62. end if
  63. s_send.sendid = 0
  64. s_send.mailtype = '发件'
  65. s_send.subject = arg_title
  66. s_send.priority = 3
  67. s_send.htmlbody = arg_content
  68. s_send.textbody = arg_content
  69. s_sendmx[1].sendid = 0
  70. s_sendmx[1].revname = arg_mailaddress
  71. s_sendmx[1].revaddress = arg_mailaddress
  72. IF obj_email.f_save(s_send,s_sendmx,s_lvfj,arg_msg) = 0 THEN
  73. rslt = 0
  74. GOTO ext
  75. END IF
  76. // 保存成功 发送
  77. string ls_run
  78. ls_run = 'longjoe_rev.exe -longjoe&'&
  79. + sys_system_id + '&'&
  80. + sys_cur_version + '&'&
  81. + String(sys_if_register) + '&'&
  82. + Commit_Tran.Database + '&'&
  83. + Commit_Tran.UserID + '&'&
  84. + f_psw_bczh(Commit_Tran.DBPass,0,sys_power_key) + '&'&
  85. + Commit_Tran.LogID + '&'&
  86. + f_psw_bczh(Commit_Tran.LogPass,0,sys_power_key) + '&'&
  87. + Commit_Tran.ServerName + '&'&
  88. + string(sys_empid) + '&'&
  89. + string(s_send.mailid) + '&'&
  90. + '1&'&
  91. + fj_tran.Database + '&'&
  92. + fj_tran.UserID + '&'&
  93. + f_psw_bczh(fj_tran.DBPass,0,sys_power_key) + '&'&
  94. + fj_tran.LogID + '&'&
  95. + f_psw_bczh(fj_tran.LogPass,0,sys_power_key) + '&'&
  96. + fj_tran.ServerName + '&'&
  97. + string(s_send.sendid) + '&'
  98. IF Run(sys_cur_path + ls_run) = -1 THEN
  99. rslt = 0
  100. arg_msg = '运行程序失败!'
  101. goto ext
  102. END IF
  103. ext:
  104. destroy obj_email
  105. return rslt
  106. end function