vb6 中的 Fortran DLL：关于"character"和"read sentence"的错误

Question

当试图将字符发送到DLL时，似乎不对(如"result_20170207"所示)。以下是关于DLL:的代码

subroutine char_1( pfilename )
!DEC$ ATTRIBUTES stdcall,DLLEXPORT::char_1
!DEC$ ATTRIBUTES ALIAS:"char_1"::char_1
!DEC$ ATTRIBUTES reference :: pfilename
character(len=512)::pfilename
!integer::i     !(about ERROR TWO )
write(*,*)trim(pfilename)
!read(*,*)i     !(about ERROR TWO )
open(unit=18,file="result_20170207",status='replace',action='write')
write(18,*)"This is dll"
write(18,*)trim(pfilename)
write(18,*)"the third line"
close(18)
end subroutine

以下是vb6.0中的代码：

Private Declare Sub char_1 Lib "D:try_vbchar_1char_1_dllchar_1_dllDebugchar_1_dll.dll" (ByVal char As String)
Private Sub Command1_Click()
Dim char As String
char = "c:/desktop/aaa.txt"
Text1.Text = char
Call char_1(char)
End Sub
Private Sub Command2_Click()
End
End Sub

错误一：结果文件中发生的错误为：错误的结果

我认为这是因为性格。为什么会发生这种情况，我该如何解决？非常感谢。

错误二：顺便说一句，当我添加代码"read(，)I"时，会遇到另一个错误。如下所示：严重(39)我添加的代码显示在注释掉的代码中：我对这两个问题感到困惑。

根据MarkJ的回答，我已经更改了我的DLL代码，如下所示(错误一；此处省略了"String_Functions模块"中的代码)：

subroutine char_1( pfilename )
!DEC$ ATTRIBUTES stdcall,DLLEXPORT::char_1
!DEC$ ATTRIBUTES ALIAS:"char_1"::char_1
!DEC$ ATTRIBUTES reference :: pfilename
use String_Functions     !--------here--------!
character(len=512)::pfilename
character(len=512)::filename
integer::ii      
ii=Clen(pfilename)      !--------here--------!
filename=Ctrim(pfilename)     !--------here--------!
open(unit=18,file="result_20170207",status='replace',action='write')
write(18,*)"This is dll"
write(18,*)filename(1:ii)      !--------here--------!
write(18,*)"the third line"
close(18)
end subroutine

Answer 1

关于您的错误(1)VB6发送了一个以null结尾的字符串。字符串包含一个ASCII零字符，该字符表示字符串的末尾。FortranTRIM不足以删除此字符。请尝试下面的CTRIM例程。

! ------------------------
PURE INTEGER FUNCTION Clen_trim(s) ! returns same result as LEN_TRIM unless:
CHARACTER(*),INTENT(IN) :: s       ! last char non-blank is null, if true:
INTEGER :: i                       ! then len of C string is returned, note:
! Ctrim is only user of this function
i = INDEX(s, CHAR(0)) 
IF ( i == 0 ) i = LEN_TRIM(s)
Clen_trim = i
END FUNCTION Clen_trim
! ----------------
FUNCTION Ctrim(s1)  RESULT(s2)     ! returns same result as TRIM unless:
CHARACTER(*),INTENT(IN)  :: s1     ! last non-blank char is null in which
CHARACTER(Clen_trim(s1)) :: s2     ! case trailing blanks prior to null
s2 = s1                            ! are output
END FUNCTION Ctrim