'On Error Resume Next Function A_GLOBES (ByVal InStr) dim ii,i,j,flag,lastflag,prN,prN1,prN2,ch,cr,cw,wword,hword,trans_src,TmpStr,tmpword ii = 0 i = 0 j = 0 flag = 0 lastflag = 0 prN = 0 prN1 = 0 prN2 = 0 ch = "" cr = "" cw = "" wword = "" hword = "" trans_src = "" TmpStr = "" tmpword = "" trans_src = InStr flag = 1 lastflag = 1 prN = 0 prN1 = 0 prN2 = 0 wword = "" hword = "" ResStr = "" For i=1 To Len(trans_src) Step 1 j = Len(trans_src) - i + 1 ch = Mid(trans_src, j, 1) If (((ch) >="à" ) And (Asc(ch) <= "ú")) Then flag = 1 Else flag = 0 End If If (i < Len(trans_src)) Then cr = Mid(trans_src, j-1, 1) cw = Mid(trans_src, j+1, 1) If (((cr) < "€") And (cw <> "%") And (cw <> " ")) Then prN1=1 Else prN1=0 End If else prN1=0 End If if (i < Len(trans_src)) Then cr = Mid(trans_src, j-1, 1) else cr = "a" End If if (((cr) > "€" or (cr) <="9") Or (flag = 1) Or (lastflag = 1)) Then prN2=1 else prN2=0 End If if ((Asc(ch) = 10) Or (Asc(ch) = 13)) Then ch=Chr(0) End If ' if (Not(((ch = " ") And (prN2 = 1)) Or (ch = Chr(34)) Or ((ch = "-") And (prN1 = 0)) Or (ch = ")") Or (ch = "(") Or (ch = "]") Or (ch = "[") Or (ch = "+") Or (ch = ";") Or ((ch = ":") And (prN1=0)) Or (ch = "%") Or (ch = "$") Or ((ch = "/") And (prN=0)) Or ((ch = "'") And (prN=0)) Or ((ch = ",") And (prN=0)) Or ((ch = ".") And (prN=0)) )) Then if (Not(((ch = " ") And (prN2 = 1)) Or (ch = Chr(34)) Or ((ch = "-") And (prN1 = 0)) Or (ch = ")") Or (ch = "(") Or (ch = "]") Or (ch = "[") Or (ch = "+") Or (ch = ";") Or ((ch = ":") And (prN1=0)) Or (ch = "%") Or (ch = "$") Or ((ch = "/") And (prN=0)) Or ((ch = "'") And (prN=0)) Or ((ch = ",") And ((prN=0) Or (prN1=0) ) ) Or ((ch = ".") And ((prN=0) Or (prN1=0) )) )) Then if (flag=1) Then hword = hword & ch else wword = wword & ch End If End If ' if ((((ch = " ") And (prN2 = 1)) Or (ch = Chr(34)) Or ((ch = "-") And (prN1 = 0)) Or (ch = ")") Or (ch = "(") Or (ch = "]") Or (ch = "[") Or (ch = "+") Or (ch = ";") Or ((ch = ":") And (prN1=0)) Or (ch = "%") Or (ch = "$") Or ((ch = "/") And (prN=0)) Or ((ch = "'") And (prN=0)) Or ((ch = ",") And (prN=0)) Or ((ch = ".") And (prN=0)) )) Then if ((((ch = " ") And (prN2 = 1)) Or (ch = Chr(34)) Or ((ch = "-") And (prN1 = 0)) Or (ch = ")") Or (ch = "(") Or (ch = "]") Or (ch = "[") Or (ch = "+") Or (ch = ";") Or ((ch = ":") And (prN1=0)) Or (ch = "%") Or (ch = "$") Or ((ch = "/") And (prN=0)) Or ((ch = "'") And (prN=0)) Or ((ch = ",") And ((prN=0) Or (prN1=0) ) ) Or ((ch = ".") And ((prN=0) Or (prN1=0))) )) Then for ii=1 To Len(wword) Step 1 ResStr = ResStr & Mid(wword, Len(wword)-ii+1, 1) Next wword = "" ResStr = ResStr & hword hword = "" ResStr = ResStr & ch flag = 1 End If if ((ch) <"€") Then prN=1 else prN=0 End If lastflag=flag Next for ii=1 To Len(wword) Step 1 ResStr = ResStr & Mid(wword, Len(wword)-ii+1, 1) Next ResStr = ResStr & hword A_GLOBES = ResStr End Function function revers(wword) dim ii,resstr resstr="" for ii=1 To Len(wword) Step 1 ResStr = ResStr & Mid(wword, Len(wword)-ii+1, 1) Next REVERS=resstr END FUNCTION Function HTMLGLOBES (ByVal InStr, ByVal LStr) Dim ii,i,j,flag,CurLength,CurNum,ch,cr,wword,trans_src,TmpStr,tmpword,ResStr,InBrak,InBrak1,BrakOn,BrHeb,BrHeb1,Per ii = 0 i = 0 j = 0 flag = 0 CurLength = 0 CurNum = 0 ch = "" cr = "" wword = "" trans_src = "" TmpStr = "" tmpword = "" ResStr = "" InBrak = False InBrak1 = False BrakOn = False BrHeb = False BrHeb1 = False Per = False if (IsNull(InStr) = True) Then trans_src = "" Else trans_src = InStr End If wword = "" ResStr = "" CurLength = 0 CurNum = 0 InBrak = False InBrak1 = False BrHeb = False BrHeb1 = False Heb = False For i=1 To Len(trans_src) Step 1 ch = Mid(trans_src, i, 1) if ((((ch) >= "à") And ((ch) <="ú")) Or (ch = "'") ) Then Heb = True End If if ((Asc(ch) <> 13) And (Asc(ch) <> 10)) Then wword = wword & ch End If CurLength = CurLength + 1 if ((((ch = " ") Or (ch = ";") Or (ch = "!") Or (ch = ",") Or (ch = "?") ) And (CurLength > LStr)) Or (Asc(ch) = 13) ) Then CurLength = 0 if (Heb = True) Then tmpword = A_GLOBES(Trim(wword)) Else tmpword = Trim(wword) End If tmpword = tmpword & "
" ResStr = ResStr & tmpword Heb = False wword = "" CurNum = CurNum+1 Else if (i = Len(trans_src)) Then if (Heb = True) Then tmpword = A_GLOBES(Trim(wword)) Else tmpword = trim(wword) End If ResStr = ResStr & tmpword End If End If Next BrHeb = False BrHeb1 = False for i=1 To Len(ResStr) Step 1 ch = Mid(ResStr, i, 1) if ( (InBrak = True) And ((Asc(ch) >= 224) And (Asc(ch) < 251)) ) Then BrHeb = True End If if ( (InBrak1 = True) And ((Asc(ch) >= 224) And (Asc(ch) < 251)) ) Then BrHeb1 = True End If if (ch = ")") Then InBrak = True BrHeb = False BrakOn = i End If if (ch = "(") Then if ( (InBrak = True) And (BrHeb = True) ) Then ' if ( (InBrak = True) ) Then TmpStr = Mid(ResStr, 1, BrakOn-1) & "(" & Mid(ResStr, BrakOn+1, Len(ResStr)) ResStr = TmpStr TmpStr = Mid(ResStr, 1, i-1) & ")" & Mid(ResStr, i+1, Len(ResStr)) ResStr = TmpStr End If InBrak = False BrHeb = False End If ' if (ch = "]") Then ' InBrak1 = True ' BrHeb1 = False ' BrakOn = i ' End If ' if (ch = "[") Then ' if ( (InBrak = True) And (BrHeb1 = True) ) Then '' if ( (InBrak = True) ) Then ' ResStr = Mid(ResStr, 1, BrakOn-1) & "[" & Mid(ResStr, BrakOn+1, Len(ResStr)-BrakOn) ' ResStr = Mid(ResStr, 1, i-1) & "]" & Mid(ResStr, i+1, Len(ResStr)-i) ' End If ' InBrak1 = False ' BrHeb1 = False ' End If Next BrHeb = False Per = False for i=1 To Len(ResStr) Step 1 ch = Mid(ResStr, i, 1) if ( (InBrak = True) And ((Asc(ch) >= 224) And (Asc(ch) < 251)) ) Then BrHeb = True End If if ( (InBrak1 = True) And ((Asc(ch) >= 224) And (Asc(ch) < 251)) ) Then BrHeb1 = True End If if ( (InBrak = True) And (ch = ">")) Then Per = True End If if (ch = "(") Then InBrak = True BrHeb = False BrakOn = i Per = False End If if (ch = ")") Then if ( (InBrak = True) And (BrHeb = True) And (Per = True) ) Then ResStr = Mid(ResStr, 1, BrakOn-1) & ")" & Mid(ResStr, BrakOn+1, Len(ResStr)) ResStr = Mid(ResStr, 1, i-1) & "(" & Mid(ResStr, i+1, Len(ResStr)) End If InBrak = False BrHeb = False Per = False End If Next HTMLGLOBES = ResStr End Function function GetHebSymbol(Asc) dim HebSymb(22) HebSymb(1)="à" HebSymb(2)="á" HebSymb(3)="â" HebSymb(4)="ã" HebSymb(5)="ä" HebSymb(6)="å" HebSymb(7)="æ" HebSymb(8)="ç" HebSymb(9)="è" HebSymb(10)="é" HebSymb(11)="ë" HebSymb(12)="ì" HebSymb(13)="î" HebSymb(14)="ð" HebSymb(15)="ñ" HebSymb(16)="ò" HebSymb(17)="ô" HebSymb(18)="ö" HebSymb(19)="÷" HebSymb(20)="ø" HebSymb(21)="ù" HebSymb(22)="ú" GetHebSymbol =HebSymb(Asc) end function