{*********************************************************************/ /* */ /* Morovia Delphi Functions, part of Morovia Font Tools V2.1 */ /* (c)2000-2004 Morovia Corporation. All rights reserved. */ /* Visit http://www.morovia.com/font/ for more information. */ /* */ /* You may incorporate this source code in your application as long */ /* as you own a perpetual license to the font product. */ /* Distributing the source code, as well as its derivatives, require */ /* a developer license. */ /* Please refer to the license agreement for details. */ /*********************************************************************} unit MoroviaFontTools; interface uses IdGlobal,Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs; Function Code39(sinpara:String) : String ; {/*---------------------------------------------------------------------*/ /* Function: Code39 - applies to Morovia Code39 Fontware */ /* Code39(text) Converts the input text into a Code 39 barcode string. The */ /* function throws off characters not in the Code 39 character set, */ /* and adds start/stop characters. */ /*----------------------------------------------------------------------*} Function UPC_E(sInpara:String) :String; Function Code39Mod43(sinpara:string):string; {/*-----------------------------------------------------------------------------*/ /*Converts the input text into a Code39 extended symbol. This function */ /*should be used to format Morovia code39 font, not Code39 full ASCII font.*/ /*The text can be any combinations of ASCII characters. Note that the symbol */ /*generated is an extended Code39, and the scanner must be put in Code39 */ /*extended mode to read the symbol properly.*/ /*----------------------------------------------------------------------------*/ } Function Code39ASCII(sInpara:String) : String ; {/*-------------------------------------------------------------------------------*/ /*Converts the input text into a Code39 extended symbol. This function should be */ /*used to format Morovia code39 font, not Code39 full ASCII font. The text can be*/ /*any combinations of ASCII characters. Note that the symbol generated is an extended*/ /*Code39, and the scanner must be put in Code39 extended mode to read the symbol properly.*/ /*-----------------------------------------------------------------------------------------*/ } Function Code39Extended(sInpara:String) : String ; {/*-------------------------------------------------------------------------------*/ /*Converts the input text into a Code39 extended symbol. It accepts any ASCII */ /*characters as input. The only difference from function Code39Ascii is the former */ /*is designed to work with Morovia Code39(Full ASCII) font and the latter is designed*/ /*to work with Morovia Code39 font.*/ /*-----------------------------------------------------------------------------------*/ } Function Code93(sInpara:String) : String ; {/*-------------------------------------------------------------------------------*/ /*Converts the input text into a Code93 symbol. It accepts any ASCII character input,*/ /*taking care of the check character calculation and adding start/stop characters into*/ /*the string.*/ /*------------------------------------------------------------------------------------*/} Function Ean13(sInpara:String) : String ; {/*----------------------------------------------------------------------------------------*/ /*Converts the input text into an EAN barcode. Accepts input of 12 digits of numeric data.*/ /*----------------------------------------------------------------------------------------*/} Function Ean8(sInpara:String) : String ; { /*----------------------------------------------------------------------------------------*/ /*Converts the input text into an EAN-8 barcode. Accepts input of 7 digits of numeric data.*/ /*----------------------------------------------------------------------------------------*/} Function UPC_A(sInpara:String) : String ; {/*----------------------------------------------------------------------------------------*/ /*Converts the input text into a UPC-A barcode. Accepts input of 11 digits of numeric data.*/ /*----------------------------------------------------------------------------------------*/} Function UPC_E(sInpara:String):String; {/*----------------------------------------------------------------------------------------*/ /*Converts the input text into a UPC-E barcode. Accepts input of 6 digits of numeric data.*/ /*----------------------------------------------------------------------------------------*/} Function Code25(inpara : String) : String; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid Code25 symbol. No check character appended.*/ /*----------------------------------------------------------------------------------------*/} Function code25Check(inpara:String): String ; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid Code25 symbol. Append a check digit.*/ /*----------------------------------------------------------------------------------------*/} Function Code11(inpara: String):string; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid Code11 symbol. Check digit as well start/stop characters*/ /*are added into the input.*/ /*----------------------------------------------------------------------------------------*/} Function Codabar(inpara : String) : String; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid Codabar symbol. The default start/stop characters are “A?/ /*and “B?*/ /*----------------------------------------------------------------------------------------*/} Function ITF25Check(inpara :String): String; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid interleaved 2 of 5 barcode. Append a check digit.*/ /*----------------------------------------------------------------------------------------*/} Function ITF25(inpara :String) :String; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid interleaved 2 of 5 barcode. No check digit appended in */ /*this function.*/ /*----------------------------------------------------------------------------------------*/} Function MSIMod10(inpara :String) : String; {/*----------------------------------------------------------------------------------------*/ /*Converts the input into a valid MSI/Plessey symbol. Check digit is calculated based on */ /*Modulo 10 algorithm.*/ /*----------------------------------------------------------------------------------------*/} Function Code128A(sInpara:String) : String ; {/*----------------------------------------------------------------------------------------*/ /*Accepts the input of character set A. Code128 character set consists of capital letters */ /*and control characters.*/ /*----------------------------------------------------------------------------------------*/} Function Code128B(sInpara:String) : String ; {/*----------------------------------------------------------------------------------------*/ /*Accepts the input of character set B. Code128 character set consist of all printable */ /*character s in the ASCII table.*/ /*----------------------------------------------------------------------------------------*/} Function Code128C(sInpara:String) : String ; {/*----------------------------------------------------------------------------------------*/ /*Code128 character set C only contains numeric characters. Used when the encoded data */ /*containing only numbers.*/ /*----------------------------------------------------------------------------------------*/} Function Code128Auto(sInpara:String) : String ; {/*----------------------------------------------------------------------------------------*/ /*Encode any ASCII characters. It automatically shift to another character set when the */ /*encoded character is not found in the current character set.*/ /*----------------------------------------------------------------------------------------*/} Function Bookland(sInpara:String) : String ; {/*--------------------------------------------------------*/ /*Converts an ISBN string into a valid Bookland barcode. */ /*--------------------------------------------------------*/} Function Postnet(sInpara:String) : String ; {/*-----------------------------------------------------------------------*/ /*Converts the input into a valid POSTNET barcode string with checksum.*/ /*The function adds the start/stop frame bar, calculating the check digit*/ /*and forms the correct symbol. This function can also be used to generate*/ /*PLANET barcode string.*/ /*-----------------------------------------------------------------------*/} Function RoyalMail(sInpara:String) : String ; {/*----------------------------------------------------------------------------*/ /*Converts the input into a valid UK royal mail barcode symbol with checksum. */ /*The function adds the start/stop frame bar, calculating the check digit and */ /*forms the correct symbol.*/ /*----------------------------------------------------------------------------*/} Function Telepen(sInpara:String) : String ; {/*----------------------------------------------------------------------------*/ /*Converts the input into a Telepen barcode string. The function accepts any */ /*ASCII character input, taking care of the check digit calculation and adding*/ /*start/stop characters.*/ /*----------------------------------------------------------------------------*/} Function TelepenNumeric(sInpara:String) : String ; {/*----------------------------------------------------------------------------*/ /*Converts the input into a Telepen Numeric barcode string. This functions */ /*accepts numeric input only.*/ /*----------------------------------------------------------------------------*/} Function UPC25SUPP(inpara :String) :String; implementation Function SpecialChar(inpara:String):String ; var nTemp,nLen,i:Integer; strTemp:char; szoutput:string; begin nLen := Length(inpara); szoutput :=''; i := 1; while(i<=nLen) do begin strTemp := inpara[i]; If (strTemp='\') Then If (i + 1 <= nLen) And (inpara[i + 1]= '\') Then begin szoutput := szoutput + '\'; i :=i + 1; end Else begin If (i+3<= nLen) And (IsNumeric(inpara[i + 1])) And IsNumeric(inpara[i + 2])And IsNumeric(inpara[i + 3]) Then begin nTemp :=100*strtoint(inpara[i+1])+10*strtoint(inpara[i+2])+strtoint(inpara[i+3]); if (nTemp = 0) then szoutput := szoutput + char(240) // use F0 to replace 0 else szoutput := szoutput +char(nTemp); i := i + 3; end Else szoutput := szoutput + strTemp; end Else szoutput := szoutput + strTemp; i:=i+1; end; SpecialChar:=szoutput; end ; Function strFind(szCharSet:string; Schar:char):integer; var i:integer; begin i := 1; strFind:=-1; while i <= length(szCharSet) do begin if (szCharSet[i] = SChar )then begin strFind:=i; break; end; i := i + 1; end; end; Function maskfilter(inpara :String; coderange :String) :string; var i,charPOS :Integer; output:string; begin output := ''; For i := 1 To Length(inpara) do begin charPos :=strFind(coderange,inpara[i]); If charPos > 0 Then output := output + copy(inpara, i, 1); End; maskfilter:=output; End; Function LeftHandEncoding(digit: Integer; parity : Integer) : String; begin Case digit of 0: If parity = 1 Then LeftHandEncoding := '/' Else If parity = 0 Then LeftHandEncoding := '?' ; 1: If parity = 1 Then LeftHandEncoding := 'z' Else If parity = 0 Then LeftHandEncoding := 'Z'; 2: If parity = 1 Then LeftHandEncoding := 'x' Else If parity = 0 Then LeftHandEncoding := 'X'; 3: If parity = 1 Then LeftHandEncoding := 'c' Else If parity = 0 Then LeftHandEncoding := 'C'; 4: If parity = 1 Then LeftHandEncoding := 'v' Else If parity = 0 Then LeftHandEncoding := 'V'; 5: If parity = 1 Then LeftHandEncoding := 'b' Else If parity = 0 Then LeftHandEncoding := 'B'; 6: If parity = 1 Then LeftHandEncoding := 'n' Else If parity = 0 Then LeftHandEncoding := 'N'; 7: If parity = 1 Then LeftHandEncoding := 'm' Else If parity = 0 Then LeftHandEncoding := 'M'; 8: If parity = 1 Then LeftHandEncoding := ',' Else If parity = 0 Then LeftHandEncoding := '<'; 9: If parity = 1 Then LeftHandEncoding := '.' Else If parity = 0 Then LeftHandEncoding := '>'; End; End ; Function UPC2SUPP(inpara:String) :String; var i,nTemp,parity1,parity2: Integer; charToEncode :char; output:string; begin nTemp := strtoint(inpara) Mod 4 ; If nTemp = 0 Then begin parity1 := 1; parity2 := 1; end Else If nTemp = 1 Then begin parity1 := 1; parity2 := 0; end Else If nTemp = 2 Then begin parity1 := 0; parity2 := 1; end Else If nTemp = 3 Then begin parity1 := 0; parity2 := 0; End; output := ''; charToEncode := inpara[1]; output := output + LeftHandEncoding(strtoint(charToEncode), parity1); output := output + '\'; charToEncode := inpara[2]; output := output + LeftHandEncoding(strtoint(charToEncode), parity2); End; Function Upce2upca(digits:string):string; begin if ( digits[1]<>'0') or (length(digits) <> 7) then begin Application.MessageBox('UPC-E must be leaded by 0 and followed by 6 numeric digits!', 'Warning', MB_OK); exit; end; case (digits[7]) of '0','1','2': Upce2upca := copy(digits, 1, 3) + copy(digits, 7, 1) + '0000' + copy(digits, 4, 3); '3': if strscan('012',digits[4])= nil then begin Application.MessageBox('Last digit is 3, then the forth digit can not be 0,1,2!', 'Warning', MB_OK); exit; end Else Upce2upca := copy(digits, 1, 4) + '00000' + copy(digits, 5, 2); '4': Upce2upca := copy(digits, 1, 5) + '00000' + copy(digits, 6, 1); '5','6','7','8','9': Upce2upca := copy(digits, 1, 6) + '0000' + copy(digits, 7, 1); else Application.MessageBox('The last digits of UPC-E code is not a numeric!', 'Warning', MB_OK); end; End; function getUpcGeneralCheck(digits:string):integer; var output,i,checkSum,strLen: Integer ; begin strLen := Length(digits); checksum:=0; For i := 1 To strLen do begin If i Mod 2 = 1 Then checkSum := checkSum + strtoint(copy(digits, strLen - i + 1, 1)) * 3 Else checkSum := checkSum + strtoint(copy(digits, strLen - i + 1, 1)); end; output := checkSum Mod 10; If output <> 0 Then output := 10 - output; getUpcGeneralCheck:=output; End ; Function Parity5(digit :Integer): String; begin Case digit of 0: Parity5 := '00111'; 1: Parity5 := '01011'; 2: Parity5 := '01101'; 3: Parity5 := '01110'; 4: Parity5 := '10011'; 5: Parity5 := '11001'; 6: Parity5 := '11100'; 7: Parity5 := '10101'; 8: Parity5 := '10110'; 9: Parity5 := '11010'; End ; End; Function UPC5SUPP(inpara :String): String; var i,weightSum: Integer; output,strParity :String; begin weightSum := 3 * strtoint(copy(inpara, 1, 1)) + 9 * strtoint(copy(inpara, 2, 1)) + 3 * strtoint(copy(inpara, 3, 1)) + 9 * strtoint(copy(inpara, 4, 1)) + 3 * strtoint(copy(inpara, 5, 1)); strParity := Parity5(weightSum Mod 10); output := '{'; For i := 1 To 5 do begin output := output + LeftHandEncoding(strtoint(copy(inpara, i, 1)), strtoint(copy(strParity, i, 1))); If (i < 5) Then output := output + '\'; end; UPC5SUPP:=output; End; Function UPC25SUPP(inpara :String) :String; var charPosition,strLen,i: Integer; charToEncode :char; output:string; begin For i := 1 To Length(inpara) do begin charToEncode := inpara[i]; charPosition := strFind('0123456789', charToEncode); If charPosition > 0 Then output := output + charToEncode; End; strLen := Length(output); If strLen = 0 Then output := UPC2SUPP('00') Else If strLen = 1 Then output := UPC2SUPP(output + '0') Else If strLen = 2 Then output := UPC2SUPP(output) Else If strLen = 3 Then output := UPC5SUPP(output + '00') Else If strLen = 4 Then output := UPC5SUPP(output + '0') Else If strLen = 5 Then output := UPC5SUPP(output) Else output := UPC5SUPP(copy(output,1,5)); UPC25SUPP:=output; End; Function convertSetCText(onedigit:char):char; begin Case onedigit of '1': convertSetCText := 'a'; '2': convertSetCText := 's'; '3': convertSetCText := 'd'; '4': convertSetCText := 'f'; '5': convertSetCText := 'g'; '6': convertSetCText := 'h'; '7': convertSetCText := 'j'; '8': convertSetCText := 'k'; '9': convertSetCText := 'l'; '0': convertSetCText := ';'; End; End ; Function convertSetAText(onedigit:char):char; begin Case onedigit of '1': convertSetAText := '1'; '2': convertSetAText := '2'; '3': convertSetAText := '3'; '4': convertSetAText := '4'; '5': convertSetAText := '5'; '6': convertSetAText := '6'; '7': convertSetAText := '7'; '8': convertSetAText := '8'; '9': convertSetAText := '9'; '0': convertSetAText := '0'; End; End ; Function convertSetBText(onedigit:char):char; begin Case onedigit of '1': convertSetBText := 'q'; '2': convertSetBText := 'w'; '3': convertSetBText := 'e'; '4': convertSetBText := 'r'; '5': convertSetBText := 't'; '6': convertSetBText := 'y'; '7': convertSetBText := 'u'; '8': convertSetBText := 'i'; '9': convertSetBText := 'o'; '0': convertSetBText := 'p'; End; End ; Function convertSetANoText(onedigit :char):char; begin Case onedigit of '1': convertSetANoText := '!'; '2': convertSetANoText := '@'; '3': convertSetANoText := '#'; '4': convertSetANoText := '$'; '5': convertSetANoText := '%'; '6': convertSetANoText := '^'; '7': convertSetANoText := '&'; '8': convertSetANoText := '*'; '9': convertSetANoText := '('; '0': convertSetANoText := ')'; End ; End ; Function convertSetCNoText(onedigit:char):char; begin Case onedigit of '1': convertSetCNoText := 'A'; '2': convertSetCNoText := 'S'; '3': convertSetCNoText := 'D'; '4': convertSetCNoText := 'F'; '5': convertSetCNoText := 'G'; '6': convertSetCNoText := 'H'; '7': convertSetCNoText := 'J'; '8': convertSetCNoText := 'K'; '9': convertSetCNoText := 'L'; '0': convertSetCNoText := ':'; End; End; Function textOnly(onedigit:char):char; begin Case onedigit of '1': textOnly := Char(193); '2': textOnly := Char(194); '3': textOnly := Char(195); '4': textOnly := Char(196); '5': textOnly := Char(197); '6': textOnly := Char(198); '7': textOnly := Char(199); '8': textOnly := Char(200); '9': textOnly := Char(201); '0': textOnly := Char(192); End; End ; Function code11checksum(inpara:string):integer; var output,strLen,charPos,i : Integer; charToEncode :char; begin strLen := Length(inpara); For i := 1 To Length(inpara) do begin charToEncode := inpara[strLen - i + 1]; charPos := strFind('0123456789-', charToEncode); If charPos > 0 Then output := i * (charPos - 1) + output; end; code11checksum:=output; End; Function Code39(sinpara:String) : String ; var i,charPos: Integer; charToEncode:char; inpara,output:String; begin output := '*'; inpara := SpecialChar(sinpara); i:=1; while i< Length(sinpara) do begin charToEncode := inpara[i]; charPos :=0; if Strscan('0123456789.+-/ $%ABCDEFGHIJKLMNOPQRSTUVWXYZ',charToEncode)<>nil then charPos :=1; If charToEncode = ' ' Then output := output + '=' Else If charPos > 0 Then output := output + charToEncode; i:=i+1; End ; output := output + '*'; Code39:=output; End; Function UPC_E(sInpara:String) :String; var nStrlen,i,checkDigit,charPos: Integer; inpara,symbmod,symset,upcaStr,strSupplement,charSet :String; charToEncode:char; output:string; begin charSet := '0123456789|'; inpara:=sinpara; nStrlen := length(Inpara); inpara := maskfilter(inpara, charSet); charPos := strFind(inpara, '|'); If charPos > 0 Then begin strSupplement := UPC25SUPP(copy(inpara, charPos+1,Length(inpara) - charPos)); inpara := copy(inpara,1,charPos-1 ); end ; If Length(inpara) < 6 Then While Length(inpara) < 6 do inpara := inpara + '0' Else If Length(inpara) > 6 Then inpara := copy(inpara,1, 6); inpara := '0' + inpara; upcaStr := Upce2upca(inpara); checkDigit := getUpcGeneralCheck(upcaStr); Case checkDigit of 0: symbmod := 'BBBAAA'; 1: symbmod := 'BBABAA'; 2: symbmod := 'BBAABA'; 3: symbmod := 'BBAAAB'; 4: symbmod := 'BABBAA'; 5: symbmod := 'BAABBA'; 6: symbmod := 'BAAABB'; 7: symbmod := 'BABABA'; 8: symbmod := 'BABAAB'; 9: symbmod := 'BAABAB'; End ; output := '['; For i := 2 To 7 do begin symset := copy(symbmod, i - 1, 1); charToEncode := inpara[i]; If symset = 'A' Then output := output + convertSetAText(charToEncode) Else If symset = 'B' Then output := output + convertSetBText(charToEncode) end; output := textOnly('0') + output+ char(39) + textOnly(char(48+checkDigit)); If strSupplement <> '' Then output:= output + ' ' + strSupplement ; UPC_E:=output; End; Function EAN13(sinpara :String) :String; var i,checkDigit,charPos:Integer; charToEncode:char; output,inpara,charSet,symbmod,symset,symPattern ,strSupplement:string; begin charSet := '0123456789|'; inpara:=sinpara; inpara := maskfilter(inpara, charSet); charPos :=strFind(inpara, '|'); If charPos > 0 Then begin strSupplement := UPC25SUPP(copy(inpara, charPos+1,Length(inpara) - charPos)); inpara := copy(inpara, 1,charPos-1); End; If Length(inpara) < 12 Then While Length(inpara) < 12 do inpara := inpara + '0' Else If Length(inpara) > 12 Then inpara :=copy(inpara,1,12); Case inpara[1] of '0': symbmod := 'AAAAAA'; '1': symbmod := 'AABABB'; '2': symbmod := 'AABBAB'; '3': symbmod := 'AABBBA'; '4': symbmod := 'ABAABB'; '5': symbmod := 'ABBAAB'; '6': symbmod := 'ABBBAA'; '7': symbmod := 'ABABAB'; '8': symbmod := 'ABABBA'; '9': symbmod := 'ABBABA'; end; output:=textOnly(inpara[1]) + '['; For i := 2 To 7 do begin symPattern := copy(symbmod, i - 1, 1); If symPattern = 'A' Then output:=output + convertSetAText(inpara[i]) Else If symPattern = 'B' Then output := output + convertSetBText(inpara[i]); end; output:= output + '|'; For i := 8 To 12 do begin output:=output + convertSetCText(inpara[i]); end; checkDigit := getUpcGeneralCheck(inpara); output := output + convertSetCText(char(48+checkDigit)) + ']'; If strSupplement <> '' Then output := output + ' ' + strSupplement; EAN13:=output; End ; Function EAN8(sinpara :String):String; var i ,checkDigit,charPos: Integer; charToEncode :char; inpara,output,charSet,strSupplement :String; begin charSet := '0123456789|'; inpara:=sinpara; inpara := maskfilter(inpara, charSet) ; charPos := strFind(inpara, '|'); If charPos > 0 Then begin strSupplement := UPC25SUPP(copy(inpara,charPos+1,Length(inpara) - charPos)); inpara := copy(inpara,1,charPos - 1); End ; If Length(inpara) < 7 Then While Length(inpara) < 7 do inpara := inpara + '0' Else If Length(inpara) > 7 Then inpara := copy(inpara,1,7); For i := 1 To 4 do output:= output + convertSetAText(inpara[i]); output:=output + '|'; For i := 5 To 7 do output:=output + convertSetCText(inpara[i]); checkDigit := getUpcGeneralCheck(inpara); output := '[' + output + convertSetCText(char(48+checkDigit)) + ']'; If strSupplement <> '' Then output := output + ' ' + strSupplement; EAN8:=output; End ; Function Code39Mod43(sinpara:string):string; var charSet,mappingSet,output,inpara:String; i,checkSum,charPos :integer; charToEncode:char; begin inpara:=''; checkSum:=0; output:=''; charSet:='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%'; mappingSet:= '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.=$/+%'; for i:=1 to length(Sinpara) do begin charPos:=strFind(charSet,sinpara[i]); if charPos>0 then inpara:=inpara+sinpara[i]; end; For i := 1 To Length(inpara) do begin charToEncode :=inpara[i]; charPos := strFind(charSet, charToEncode); checkSum := checkSum + (charPos - 1); output := output + copy(mappingSet, charPos, 1); end; checkSum := checkSum Mod 43; Code39Mod43 := '*' +output + copy(mappingSet, checkSum + 1, 1) + '*' End ; Function UPC_A(sinpara :String) :String; var manfac, product,manuStr, prodStr, finalString, strSupplement,inpara,output,charSet : String; checkDigit,i,charPos :Integer ; sysAssign:char; begin charSet := '0123456789|' ; inpara:=sinpara; inpara := maskfilter(inpara, charSet); charPos := strFind(inpara, '|'); If charPos > 0 Then begin strSupplement := UPC25SUPP(copy(inpara,charPos+1,Length(inpara) - charPos)); inpara := copy(inpara,1,charPos - 1); End ; If Length(inpara) < 11 Then While Length(inpara) < 11 do inpara := inpara + '0' Else If Length(inpara) > 11 Then inpara := copy(inpara,1,11); sysAssign := inpara[1]; finalString := textOnly(sysAssign) + '[' + convertSetANoText(sysAssign); manuStr := ''; For i:= 1 To 5 do manuStr := manuStr + convertSetAText(inpara[1 + i]); finalString := finalString + manuStr; prodStr := ''; For i:= 1 To 5 do prodStr := prodStr + convertSetCText(inpara[6 + i]); finalString := finalString + '|' + prodStr; checkDigit := getUpcGeneralCheck(inpara); finalString := finalString + convertSetCNoText(char(48+checkDigit)) + ']' + textOnly(char(48+checkDigit)); output:= finalString; If strSupplement <> '' Then output:= output + ' ' + strSupplement; UPC_A:=output; End; Function Code11(inpara: String):string; var cCheckSum,kchecksum: Integer; ccheckdigit : String; kcheckdigit : String; output,charSet :String; begin charSet := '0123456789-' ; output := maskfilter(inpara, charSet); cCheckSum := code11checksum(output); cCheckSum := cCheckSum Mod 11; ccheckdigit := copy(charSet, cCheckSum + 1, 1); output := output + ccheckdigit; If Length(output) > 11 Then begin kchecksum := code11checksum(output); kchecksum := kchecksum Mod 9; kcheckdigit := char(kchecksum + 48); output := '[' + output + kcheckdigit + ']'; end Else output:= '[' + output + ']'; Code11:=output; End; Function Code11a(inpara :String):string; var output,strStageOne : String; i: Integer; begin strStageOne := maskfilter(inpara, '01234567890-'); strStageOne := Code11(strStageOne); output := '' ; For i := 1 To Length(strStageOne) do begin Case strStageOne[i] of '[': output := output + strStageOne[i]; ' ': output := output + strStageOne[i]; ']': output := output + strStageOne[i]; '-': output := output + '_'; '1': output := output + '!'; '2': output := output + '@'; '3': output := output + '#'; '4': output := output + '$'; '5': output := output + '%'; '6': output := output + '^'; '7': output := output + '&'; '8': output := output + '*'; '9': output := output + '('; '0': output := output + ')'; End; end; Code11a:=output; End; Function Code25(inpara : String) : String; var i : Integer; charToEncode : String; charPos : Integer; output:string; begin output:=''; For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); charPos := strFind('0123456789', charToEncode[1]); If charPos > 0 Then output := output + charToEncode; end; Code25 := '[' + output + ']'; End; Function code25Check(inpara:String): String ; var charPos,i,checkSum,strLen :Integer; charToEncode :char; output,checkDigit:String; begin checksum:=0; // filter character For i:= 1 To Length(inpara) do begin charToEncode := inpara[i]; charPos := strFind('0123456789', charToEncode); If charPos > 0 Then output:= output + charToEncode; end; strLen := Length(output); For i := 1 To strLen do If i Mod 2 = 1 Then checkSum := checkSum + 3 * strtoint(copy(output, strLen - i + 1, 1)) Else checkSum := checkSum + strtoint(copy(output, strLen - i + 1, 1)) ; checkSum := checkSum Mod 10; If checkSum = 0 Then checkDigit := '0' Else checkDigit := Char(10 - checkSum + 48); code25Check := '[' + output + checkDigit + ']' ; End; Function ITF25Check(inpara :String): String; var i ,charPos, checkSum , charVal ,strLen :Integer; charToEncode:string; output,strTemp,checkDigit : String; begin // filter character checksum:=0; For i := 1 To Length(inpara) do begin charToEncode := inpara[i]; charPos := strFind('0123456789', charToEncode[1]); If charPos > 0 Then strTemp:= strTemp + charToEncode; end; strLen := Length(strTemp); If strLen Mod 2 = 0 Then strTemp := strTemp + '0'; For i := 1 To strLen do If i Mod 2 = 1 Then checkSum := checkSum + 3 * strtoint(copy(strTemp, strLen - i + 1, 1)) Else checkSum := checkSum + strtoint(copy(strTemp, strLen - i + 1, 1)); checkSum := checkSum Mod 10; If checkSum = 0 Then checkDigit := '0' Else checkDigit := Char(10 - checkSum + 48); If Length(strTemp) Mod 2 = 0 Then strTemp := strTemp + '0'; strTemp := strTemp + checkDigit; i := 1 ; strLen := Length(strTemp); while i<=strLen do begin charToEncode := copy(strTemp, i, 2); charVal := strtoint(charToEncode); If (charVal >= 0) And (charVal <= 93) Then output:= output + Char(ord('!') + charVal) Else output := output + Char(charVal - 94 + 196); i:=i+2; End; ITF25Check := Char(202) + output + Char(203); End; Function ITF25(inpara :String) :String; var charPos,i,checkSum,charVal:Integer; output,charToEncode,strTemp ,checkDigit: String; begin //' filter character checksum:=0; For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); charPos := strFind('0123456789', charToEncode[1]); If charPos > 0 Then strTemp := strTemp + charToEncode; end; If Length(strTemp) Mod 2 = 1 Then strTemp := strTemp + '0'; i:=1; while i<= Length(strTemp) do begin charToEncode := copy(strTemp, i, 2); charVal := strtoint(charToEncode); If (charVal >= 0) And (charVal <= 93) Then output:= output + Char(ord('!') + charVal) Else output:= output + Char(charVal - 94 + 196); i:=i+2; End; ITF25 := Char(202) + output + Chr(203); End; Function MSIMod10(inpara :String) : String; var charPos,choice,strLen,charVal,checkSum, i : Integer; charToEncode : String; checkDigit : String; output,newno :String; begin //' filter character checksum:=0; For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); charPos := strfind('0123456789', charToEncode[1]); If charPos > 0 Then output:= output + charToEncode; end; strLen := Length(output); choice := strLen Mod 2; For i := 1 To strLen do begin charToEncode := copy(output, i, 1); charVal := strtoint(charToEncode); If i Mod 2 = choice Then newno := newno + charToEncode Else checkSum := checkSum + charVal; End ; newno := inttostr(2 * strtoint(newno)); For i := 1 To Length(newno) do checkSum := checkSum + strtoint(copy(newno, i, 1)); checkSum := checkSum Mod 10; If checkSum <> 0 Then checkSum := 10 - checkSum; MSIMod10 := '[' + output + Char(ord('0') + checkSum) + ']'; End; Function Code128aCharSet(): String; var i : Integer; output:string; begin For i := 32 To 95 do output := output + Char(i); For i := 0 To 31 do output := output + Char(i); For i := 193 To 199 do output := output+ Char(i); Code128aCharSet:=output; End ; Function Code128bCharSet() : String; var i : Integer; output:string; begin For i := 32 To 127 do output := output + Char(i); For i := 193 To 199 do output := output + Char(i); Code128bCharSet:=output; End ; Function Code128cCharset() : String; var i : Integer; output:string; begin For i:= 0 To 9 do output:= output + Char(i + ord('0')); For i := 192 To 199 do output:= output+ Char(i); Code128cCharSet:=output; End ; Function code128MappingSet() : String; var i : Integer; output:string; begin output := Char(204); For i := 33 To 126 do output := output+ Char(i); For i := 192 To 202 do output := output + Char(i) ; code128MappingSet:=output; End ; Function code128Auto(sinpara :String): String; var i : Integer; charToEncode : String; charPos : Integer; checkSum : Integer; checkDigit : String; AcharSet : String; BcharSet : String; CcharSet : String; mappingSet : String; curCharSet : String; strLen : Integer; charVal : Integer; weight : Integer; inpara,output:string; begin checksum:=0; AcharSet := Code128aCharSet(); BcharSet := Code128bCharSet(); CcharSet := Code128cCharset(); mappingSet := code128MappingSet(); inpara:=sinpara; inpara := SpecialChar(inpara); If inpara = '' Then begin output:= ''; Exit ; End; strLen := Length(inpara); charVal := ord(inpara[1]); If charVal <= 31 Then curCharSet := AcharSet; If (charVal >= 32) And (charVal <= 126) Then curCharSet := BcharSet; If (strLen > 4) And (IsNumeric(inpara[1])) and (IsNumeric(inpara[2])) and (IsNumeric(inpara[3])) and (IsNumeric(inpara[4])) Then curCharSet := CcharSet; if curCharSet = AcharSet then output := output+ Char(200) else if curCharSet=BcharSet then output := output + Char(201) else if curCharSet= CcharSet then output:= output+ Char(202); i:=1; while i<=strLen do begin charToEncode := copy(inpara, i, 1); charVal := ord(charToEncode[1]); If charVal = 199 Then output := output + Char(199) Else If ((i < strLen - 2) And (IsNumeric(charToEncode[1])) And (IsNumeric(inpara[i + 1])) And (IsNumeric(inpara[1])) and IsNumeric(inpara[2]) and IsNumeric(inpara[3]) and IsNumeric(inpara[4])) Or ((i < strLen) And (IsNumeric(charToEncode[1])) And (IsNumeric(inpara[i + 1])) And (curCharSet = CcharSet)) Then begin If curCharSet <> CcharSet Then begin output := output + Char(196); curCharSet := CcharSet; End ; charToEncode := copy(inpara, i, 2); charVal := strtoint(charToEncode); output := output + copy(mappingSet, charVal + 1, 1); i := i + 1; end Else If ((i <= strLen) And (charVal < 31)) Or ((curCharSet = AcharSet) And ((charVal > 32) And (charVal < 96))) Then begin If curCharSet <> AcharSet Then begin output := output + Chr(198); curCharSet := AcharSet; End ; charPos := strFind( curCharSet, charToEncode[1]); output := output+ copy(mappingSet, charPos, 1); end Else If (i <= strLen) And ((charVal > 31) And (charVal < 127)) Then begin If curCharSet <> BcharSet Then begin output := output+ Char(197); curCharSet := BcharSet; End; charPos := strFind(curCharSet, charToEncode[1]); output := output+ copy(mappingSet, charPos, 1); End; i:=i+1; end; strLen := Length(output); For i := 1 To strLen do begin charVal := ord(output[i]); If charVal = 204 Then charVal := 0 Else If charVal <= 126 Then charVal := charVal - 32 Else If charVal >= 192 Then charVal := charVal - 97; If i > 1 Then weight := i - 1 Else weight := 1; checkSum := checkSum + charVal * weight; end; checkSum := checkSum Mod 103; checkDigit := copy(mappingSet, checkSum + 1, 1); code128Auto := output + checkDigit + Char(203) + Char(205); End ; Function Code128A(sinpara : String) : String; var i ,charPos, checkSum: Integer; charToEncode : String; checkDigit : String ; strTemp : String ; AcharSet : String; filterSet : String; inpara,output, mappingSet : String ; begin checksum:=0; inpara:=sinpara; AcharSet := Code128aCharSet(); mappingSet := code128MappingSet(); inpara := SpecialChar(inpara); // ' filter characters For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1) ; charPos := strFind(AcharSet, charToEncode[1]); If charPos > 0 Then strTemp := strTemp + charToEncode; end; checkSum := 103; // start char of 128a For i := 1 To Length(strTemp) do begin charToEncode := copy(strTemp, i, 1); charPos := strFind(AcharSet, charToEncode[1]); If charPos > 0 Then begin output:= output + copy(mappingSet, charPos, 1); checkSum := checkSum + i * (charPos - 1); End ; end; checkSum := checkSum Mod 103; checkDigit := copy(mappingSet, checkSum + 1, 1); Code128A := Char(200) + output + checkDigit + Char(203) + Char(205); End; Function Code128B(sinpara :String) : String; var i,charPos,checkSum: Integer; charToEncode :String; strTemp :String; checkDigit :String; BcharSet :String; inpara,output,mappingSet :String; begin checksum:=0; inpara:=sinpara; BcharSet := Code128bCharSet(); mappingSet := code128MappingSet(); inpara := SpecialChar(inpara); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); charPos := strFind(BcharSet, charToEncode[1]); If charPos > 0 Then strTemp := strTemp + charToEncode; end; checkSum := 104; // ' start char of code128b For i := 1 To Length(strTemp) do begin charToEncode := copy(strTemp, i, 1); charPos := strFind(BcharSet, charToEncode[1]); If charPos > 0 Then begin output := output + copy(mappingSet, charPos, 1); checkSum := checkSum + i * (charPos - 1); End ; end; checkSum := checkSum Mod 103; checkDigit := copy(mappingSet, checkSum + 1, 1); Code128B := Char(201) + output + checkDigit + Char(203) + Char(205); End; Function Code128C(sinpara :String) :String; var i,charPos,checkSum,charVal: Integer; charToEncode : String; strTemp : String; checkDigit : String; CcharSet : String; inpara,output,mappingSet : String; begin checksum:=0; inpara:=sinpara; CcharSet := Code128cCharset(); mappingSet := code128MappingSet(); //' filter unaccepted characters inpara := SpecialChar(inpara); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); charPos := strFind(CcharSet, charToEncode[1]); If charPos > 0 Then strTemp := strTemp + charToEncode; end; If (Length(strTemp) Mod 2) = 1 Then strTemp := strTemp + '0'; checkSum := 105; i:=1; while i<=Length(strTemp) do begin charToEncode := copy(strTemp, i, 2); charVal := strtoint(charToEncode); output:= output + copy(mappingSet, charVal + 1, 1); i:=i+2; end; For i := 1 To Length(output) do begin charToEncode := copy(output, i, 1); charVal := ord(charToEncode[1]); If charVal = 204 Then charVal := 0 Else If (charVal >= 33) And (charVal < 127) Then checkSum := checkSum + i * (charVal - 32) Else checkSum := checkSum + i * (charVal - 97); end; checkSum := checkSum Mod 103; checkDigit := copy(mappingSet, checkSum + 1, 1); Code128C := Char(202) + output + checkDigit + Char(203) + Char(205); End; Function Code93(sinpara:String):String; var i,charPos,weightC,weightK,checkSumC,checkSumK : Integer; charToEncode : String; charSet : String; mappingSet :String; output,inpara,strTemp : String; begin weightC:=0; weightK:=0; checkSumC:=0; checkSumK:=0; inpara:=sinpara; charSet :='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%@#^&'; mappingSet := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-.=$/+%@#^&'; inpara := SpecialChar(inpara); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); If ord(charToEncode[1]) = 0 Then // 'control characters strTemp := strTemp + '#' + 'U' Else If (ord(charToEncode[1]) >= 1) And (ord(charToEncode[1]) <= 26) Then strTemp := strTemp + '@' + Char(ord(charToEncode[1]) + ord('A') - 1) Else If (ord(charToEncode[1]) >= 27) And (ord(charToEncode[1]) <= 31) Then strTemp := strTemp + '#' + Char(ord(charToEncode[1]) - 27 + ord('A')) Else If ord(charToEncode[1]) = 32 Then // 'control characters strTemp := strTemp + '=' Else If (ord(charToEncode[1]) >= 33) And (ord(charToEncode[1]) <= 44) Then strTemp := strTemp + '^' + Char(ord(charToEncode[1]) - 33 + ord('A')) Else If charToEncode = '-' Then //'45 strTemp := strTemp + charToEncode Else If charToEncode = '.' Then //'46 strTemp := strTemp + charToEncode Else If charToEncode = '/' Then// '47 strTemp := strTemp + '^' + 'O' Else If (ord(charToEncode[1]) >= 48) And (ord(charToEncode[1]) <= 57) Then strTemp := strTemp + charToEncode Else If charToEncode = ':' Then //'58 strTemp := strTemp + '^' + 'Z' Else If (ord(charToEncode[1]) >= 59) And (ord(charToEncode[1]) <= 63) Then strTemp := strTemp + '#' + Char(ord(charToEncode[1]) - 59 + ord('F')) Else If ord(charToEncode[1]) = 64 Then strTemp := strTemp + '#' + 'V' Else If (ord(charToEncode[1]) >= 65) And (ord(charToEncode[1]) <= 90) Then strTemp := strTemp + charToEncode Else If (ord(charToEncode[1]) >= 91) And (ord(charToEncode[1]) <= 95) Then strTemp := strTemp + '#' + Char(ord(charToEncode[1]) - 91 + ord('K')) Else If ord(charToEncode[1]) = 96 Then strTemp := strTemp + '#' + 'W' Else If (ord(charToEncode[1]) >= 97) And (ord(charToEncode[1]) <= 122) Then strTemp := strTemp + '&' + Char(ord(charToEncode[1]) - 97 + ord('A')) Else If (ord(charToEncode[1]) >= 123) And (ord(charToEncode[1]) <= 127) Then strTemp := strTemp + '#' + Char(ord(charToEncode[1]) - 123 + ord('P')); end; output:= strTemp; For i := 1 To Length(output) do begin weightC := i Mod 20; //Added by Ben May 12,2004 if weightC=0 then weightC=20; charToEncode := copy(output, Length(output) - i + 1, 1); charPos := strFind( mappingSet, charToEncode[1]); checkSumC := checkSumC + weightC * (charPos - 1) ; end; output:= output + copy(mappingSet, (checkSumC Mod 47) + 1, 1); For i := 1 To Length(output) do begin weightK := i Mod 15; //Added by Ben May 12,2004 if weightK=0 then weightK=15; charToEncode :=copy(output, Length(output) - i + 1, 1); charPos := strFind(mappingSet, charToEncode[1]); checkSumK := checkSumK + weightK * (charPos - 1); end; output:= output + copy(mappingSet, (checkSumK Mod 47) + 1, 1); Code93 := '[' + output + ']' + '|'; End; Function Codabar(inpara : String) : String; var i,charPos: Integer; charToEncode : String; output,charSet : String; begin charSet := '0123456789-$:/.+'; For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); // 'definition of a valid Codabar character set. charPos := strFind( charSet, charToEncode[1]); If charPos > 0 Then output:= output + charToEncode; end; Codabar := 'A' + output + 'B'; End; Function Code39Ascii(sinpara : String) : String; var i : Integer; charToEncode : String; charSet : String; mappingSet : String; inpara,output,strTemp : String; begin inpara:=sinpara; inpara := SpecialChar(inpara); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); If ord(charToEncode[1]) = 0 Then // 'control characters strTemp := strTemp + '%U' Else If (ord(charToEncode[1]) >= 1) And (ord(charToEncode[1]) <= 26) Then strTemp := strTemp + '$' + Char(ord(charToEncode[1]) + ord('A') - 1) Else If (ord(charToEncode[1]) >= 27) And (ord(charToEncode[1]) <= 31) Then strTemp := strTemp + '%' + Char(ord(charToEncode[1]) - 27 + ord('A')) Else If ord(charToEncode[1]) = 32 Then //'control characters strTemp := strTemp + '=' Else If (ord(charToEncode[1]) >= 33) And (ord(charToEncode[1]) <= 44) Then strTemp := strTemp + '/' + Char(ord(charToEncode[1]) - 33 + ord('A')) Else If charToEncode = '-' Then //'45 strTemp := strTemp + charToEncode Else If charToEncode = '.' Then// '46 strTemp := strTemp + charToEncode Else If charToEncode = '/' Then //'47 strTemp := strTemp + '/O' Else If (ord(charToEncode[1]) >= 48) And (ord(charToEncode[1]) <= 57) Then strTemp := strTemp + charToEncode Else If charToEncode = ':' Then //'58 strTemp := strTemp + '/Z' Else If (ord(charToEncode[1]) >= 59) And (ord(charToEncode[1]) <= 63) Then strTemp := strTemp + '%' + Char(ord(charToEncode[1]) - 59 + ord('F')) Else If ord(charToEncode[1]) = 64 Then strTemp := strTemp + '%V' Else If (ord(charToEncode[1]) >= 65) And (ord(charToEncode[1]) <= 90) Then strTemp := strTemp + charToEncode Else If (ord(charToEncode[1]) >= 91) And (ord(charToEncode[1]) <= 95) Then strTemp := strTemp + '%' + Char(ord(charToEncode[1]) - 91 + ord('K')) Else If ord(charToEncode[1]) = 96 Then strTemp := strTemp + '%W' Else If (ord(charToEncode[1]) >= 97) And (ord(charToEncode[1]) <= 122) Then strTemp := strTemp + '+' + Char(ord(charToEncode[1]) - 97 + ord('A')) Else If (ord(charToEncode[1]) >= 123) And (ord(charToEncode[1]) <= 127) Then strTemp := strTemp + '%' + Char(ord(charToEncode[1]) - 123 + ord('P')); End ; Code39Ascii := '[' + strTemp + ']' ; End; Function Code39Extended(sinpara :String) : String; var charVal,i : Integer; inpara,output,charToEncode : String; begin inpara := SpecialChar(sinpara); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); charVal := ord(charToEncode[1]); If charToEncode = ' ' Then output := output + '=' Else If charToEncode = '*' Then output := output + Char(244) Else If charToEncode = '=' Then output := output + Char(240) Else If charToEncode = '[' Then output := output + Char(241) Else If charToEncode = ']' Then output := output + Char(242) Else If charVal = 127 Then output := output + Char(224) Else If (charVal >= 0) And (charVal <= 31) Then output := output + Char(192 + charVal) Else output := output + charToEncode End ; Code39Extended := '*' + output + '*'; End ; Function Bookland(sinpara :String) :String; var charPos,i : Integer; charSet :String; strLeft :String; inpara,output,strRight :String; begin inpara:=sinpara; charPos := strFind(inpara, '|'); If charPos > 0 Then begin strLeft := copy(inpara, 1,charPos - 1); strRight := copy(inpara, charPos + 1, Length(inpara) - charPos); end Else strLeft:= inpara; charSet := '0123456789'; strLeft := maskfilter(strLeft, charSet); strRight := maskfilter(strRight, charSet); If Length(strLeft) > 10 Then strLeft := copy(strLeft,1, 10) Else If Length(inpara) < 10 Then While Length(strLeft) < 10 do strLeft := strLeft + '0'; strLeft := '978' + copy(strLeft,1, 9); output := EAN13(strLeft); If charPos > 0 Then output:= output + ' ' + UPC25SUPP(strRight); Bookland:=output; End; Function codeISBN(sinpara :String) : String; var i,charPos,weight,checkSum : Integer; charToEncode : String ; checkDigit : String; inpara,output,charSet : String; begin checkSum:=0; inpara:=sinpara; charSet := '0123456789'; inpara := maskfilter(inpara, charSet); If Length(inpara) > 9 Then inpara := copy(inpara,1,9) Else If Length(inpara) < 9 Then While Length(inpara) < 9 do inpara := inpara + '0'; output:= inpara; For i := 1 To Length(output) do begin weight := 11 - i; charToEncode := copy(output, i, 1); checkSum := checkSum + weight * strtoint(charToEncode); end; checkSum := 11 - (checkSum Mod 11); checkDigit := Char(checkSum + ord('0')); codeISBN := output + checkDigit; End; Function EAN128(sinpara : String) : String; var i,strLen,checkSum,weight,charValue: Integer; charToEncode : String; strCodeWord : String; strTemp : String; checkDigit : String; inpara,output,mappingSet : String; begin checksum:=0; inpara:=sinpara; mappingSet := code128MappingSet(); inpara := SpecialChar(inpara); strLen := Length(inpara); i:=1; while i <= strLen do begin If inpara[i] = Char(199) Then strTemp := strTemp + Char(199) Else If IsNumeric(inpara[i]) Then If (i + 1 <= strLen )And (IsNumeric(inpara[i + 1])) Then begin strTemp := strTemp + copy(inpara, i, 2); i := i + 1; end Else strTemp := strTemp + copy(inpara, i, 1) + '0'; i:=i+1; end; strLen := Length(strTemp); checkSum := 105 + 102; weight := 2; i:=1; while i <= strLen do begin charToEncode := copy(strTemp, i, 1); If charToEncode[1] <> Char(199) Then // ' not FNC1 begin charValue := strtoint(copy(strTemp, i, 2)); strCodeWord := strCodeWord + copy(mappingSet, charValue + 1, 1); charValue := charValue * weight; i:= i + 1 ; end Else // ' Fnc1 begin strCodeWord := strCodeWord + Char(199); charValue := 102 * weight; End ; checkSum := checkSum + charValue; weight := weight + 1; i:=i+1; end; checkSum := checkSum Mod 103; checkDigit := copy(mappingSet, checkSum + 1, 1); EAN128 := Char(202) + Char(199) + strCodeWord + checkDigit + Char(203) + Char(205); End; Function SCC14(sinpara : String) :String; var i,strLen,checkSum,weight,charValue: Integer; charToEncode :String; strTemp : String; inpara,output,checkDigit :String; begin checksum:=0; inpara:=sinpara; strLen := Length(inpara); For i := 1 To strLen do begin charToEncode := copy(inpara, i, 1); If (charToEncode[1] >= '0') And (charToEncode[1] <= '9') Then strTemp := strTemp + charToEncode; end; If Length(strTemp) = 14 Then strTemp := copy(strTemp, 1, 13); If (Length(strTemp) = 15) Or (Length(strTemp) = 16) Or (Length(strTemp) = 17) Then strTemp := copy(strTemp, 3, 13); If Length(strTemp) <> 13 Then Exit ; strLen := Length(strTemp); For i := 1 To strLen do begin charValue := strtoint(copy(strTemp, strLen - i + 1, 1)); If (i Mod 2) = 1 Then weight := 3 Else weight := 1 ; checkSum := checkSum + charValue * weight; end; checkSum := checkSum Mod 10; If checkSum = 0 Then checkDigit := '0' Else checkDigit := Char(10 - checkSum + ord('0')); SCC14 := EAN128('01' + strTemp + checkDigit); End; Function SSCC18(sinpara :String) :String ; var strLen,checkSum,weight,charValue,i : Integer; charToEncode :String; strTemp : String; output,inpara,checkDigit : String; begin checksum:=0; inpara := SpecialChar(sinpara); strLen := Length(inpara); For i := 1 To strLen do begin charToEncode := copy(inpara, i, 1); If (charToEncode[1] >= '0') And (charToEncode[1] <= '9') Then strTemp := strTemp + charToEncode; end; If Length(strTemp) = 18 Then strTemp := copy(strTemp, 1, 17); If (Length(strTemp) = 19) Or (Length(strTemp) = 20) Or (Length(strTemp) = 21) Then strTemp := copy(strTemp, 3, 17); If Length(strTemp) <> 17 Then Exit ; strLen := Length(strTemp); For i := 1 To strLen do begin charValue := strtoint(copy(strTemp, strLen - i + 1, 1)); If (i Mod 2) = 1 Then weight := 3 Else weight := 1 ; checkSum := checkSum + charValue * weight; end; checkSum := checkSum Mod 10 ; If checkSum = 0 Then checkDigit := '0' Else checkDigit := Char(10 - checkSum + ord('0')); SSCC18 := EAN128('00' + strTemp + checkDigit); End; Function USPS_EAN128(sinpara : String) : String; var i :Integer; charToEncode : String; strTemp :String; strLen : Integer; checkSum : Integer; checkDigit :String; weight :Integer; charValue : Integer; inpara:string; begin checksum:=0; inpara := SpecialChar(sinpara) ; strLen := Length(inpara); For i := 1 To strLen do begin charToEncode := copy(inpara, i, 1); If (charToEncode[1] >= '0') And (charToEncode[1] <= '9') Then strTemp := strTemp + charToEncode; end; If Length(strTemp) > 19 Then strTemp := copy(strTemp, 1, 19); If Length(strTemp) <> 19 Then strTemp := '0000000000000000000'; strTemp := '91' + strTemp; strLen := Length(strTemp); For i := 1 To strLen do begin charValue := strtoint(copy(strTemp, strLen - i + 1, 1)); If (i Mod 2) = 1 Then weight := 3 Else weight := 1; checkSum := checkSum + charValue * weight ; end; checkSum := checkSum Mod 10; If checkSum = 0 Then checkDigit := '0' Else checkDigit := Char(10 - checkSum + ord('0')); USPS_EAN128 := EAN128(strTemp + checkDigit); End ; Function USPS_USS128(sinpara :String) :String; var i : Integer; charToEncode : String; strTemp : String; strLen : Integer; checkSum : Integer; checkDigit : String; weight : Integer; charValue : Integer; inpara:string; begin checksum:=0; inpara := SpecialChar(sinpara); strLen := Length(inpara); For i := 1 To strLen do begin charToEncode := copy(inpara, i, 1); If (charToEncode[1] >= '0') And (charToEncode[1] <= '9') Then strTemp := strTemp + charToEncode; end; If Length(strTemp) = 20 Then strTemp := copy(strTemp, 1, 19); If Length(strTemp) <> 19 Then Exit; strLen := Length(strTemp); For i := 1 To strLen do begin charValue := strtoint(copy(strTemp, strLen - i + 1, 1)); If (i Mod 2) = 1 Then weight := 3 Else weight := 1; checkSum := checkSum + charValue * weight; end; checkSum := checkSum Mod 10; If checkSum = 0 Then checkDigit := '0' Else checkDigit:= Char(10 - checkSum + ord('0')); USPS_USS128 := EAN128(strTemp + checkDigit) ; End; Function RoyalMail(sinpara :String) :String; var i : Integer; charToEncode : String; charSet : String; charPos : Integer; charVal : Integer; checkSum : Integer; checkDigit : String; tu : Integer; tl :Integer; temp : Integer; inpara,output:string; begin; charSet := '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'; inpara:=sinpara; checksum:=0; For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1) ; charPos := strFind(charSet, charToEncode[1]); // binaray character If (charPos > 0) Then begin output := output + charToEncode; charVal := ord(charToEncode[1]); If (charVal < 65) Then charVal := charVal - 48 Else charVal := charVal - 55; temp := charVal div 6; If (temp >= 5) Then checkSum := 0 Else checkSum := temp + 1; tu := tu + checkSum; temp := charVal - temp * 6; If temp >= 5 Then checkSum := 0 Else checkSum := temp + 1; tl := tl + checkSum ; end; end; tu := tu Mod 6; If tu = 0 Then tu := 6; tl := tl Mod 6; If tl = 0 Then tl := 6; checkSum := (tu - 1) * 6 + tl - 1; If checkSum < 10 Then checkDigit := Char(checkSum + 48) Else checkDigit := Char(checkSum + 55); RoyalMail := '[' + output + checkDigit + ']'; End ; Function Postnet(sinpara: String): String ; var i : Integer; charToEncode : String; checkSum : Integer; checkDigit : String; charSet :String; inpara,output:string; begin checksum:=0; inpara:=sinpara; charSet := '0123456789'; inpara := maskfilter(inpara, charSet); If (Length(inpara) >= 0) And (Length(inpara) < 5) Then While Length(inpara) < 5 do inpara := inpara + '0' Else If (Length(inpara) > 5) And (Length(inpara) < 9) Then While Length(inpara) < 9 do inpara := inpara + '0' Else If (Length(inpara) > 9) And (Length(inpara) < 13) Then While Length(inpara) < 13 do inpara := inpara + '0' Else If Length(inpara) > 13 Then inpara := copy(inpara,1, 13); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); If IsNumeric(charToEncode[1]) Then begin output:= output + charToEncode; checkSum := checkSum + strtoint(charToEncode); End ; end; checkSum := checkSum Mod 10; If checkSum <> 0 Then checkSum := 10 - checkSum; checkDigit := Char(checkSum + ord('0')); Postnet := '[' + output + checkDigit + ']' ; End ; Function telepen(sinpara :String) : String; var charToEncode : String; charPos : Integer; strTemp : String; checkSum : Integer; checkDigit : String; i : Integer; inpara,output:string; begin checksum:=0; inpara := SpecialChar(sinpara); For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1) ; If (ord(charToEncode[1]) >= 0) And (ord(charToEncode[1]) <= 127) Then begin strTemp := strTemp + charToEncode; checkSum := checkSum + ord(charToEncode[1]); End; end; checkDigit := Char(127 - (checkSum Mod 127)); strTemp := strTemp + checkDigit; For i := 1 To Length(strTemp) do begin charToEncode := copy(strTemp, i, 1); If (charToEncode[1] = ' ') Then output:= output + '=' Else If (charToEncode[1] = '=') Then output := output + Chr(240) Else If (charToEncode[1] = '[') Then output := output + Char(241) Else If (charToEncode[1] = ']') Then output := output+ Char(242) Else If (ord(charToEncode[1]) >= 0) And (ord(charToEncode[1]) <= 31) Then output := output + Char(ord(charToEncode[1]) + 192) Else If (ord(charToEncode[1]) = 127) Then output := output + Char(224) Else output := output + charToEncode; End ; telepen := '[' + output + ']'; End ; Function telepenNumeric(sinpara : String) :String ; var i : Integer; charToEncode : String; charPos : Integer; checkSum : Integer; strTemp : String; checkDigit : String; charVal : Integer; CcharSet : String; mappingSet : String; inpara,output:string; begin checksum:=0; //' filter unaccepted characters inpara:=sinpara; For i := 1 To Length(inpara) do begin charToEncode := copy(inpara, i, 1); If (charToEncode[1] >= '0') And (charToEncode[1] <= '9') Then strTemp := strTemp + charToEncode; end; If (Length(strTemp) Mod 2) = 1 Then strTemp := strTemp + '0'; i:=1; while i <=Length(strTemp) do begin charToEncode := copy(strTemp, i, 2); charVal := strtoint(charToEncode) + 27; mappingSet := mappingSet + Char(charVal); i:=i+2; end; For i := 1 To Length(mappingSet) do begin charToEncode := copy(mappingSet, i, 1); charVal := ord(charToEncode[1]); checkSum := checkSum + charVal; end; checkDigit := Char(127 - (checkSum Mod 127)); mappingSet := mappingSet + checkDigit; For i := 1 To Length(mappingSet) do begin charToEncode := copy(mappingSet, i, 1) ; If (charToEncode[1] = ' ') Then output := output + '=' Else If (charToEncode[1] = '=') Then output := output + Char(240) Else If (charToEncode[1] = '[') Then output := output + Chr(241) Else If (charToEncode[1] = ']') Then output:= output + Chr(242) Else If (ord(charToEncode[1]) >= 0) And (ord(charToEncode[1]) <= 31) Then output := output + Chr(ord(charToEncode[1]) + 192) Else If (ord(charToEncode[1]) = 127) Then output := output + Chr(224) Else output := output + charToEncode; end; telepenNumeric := '[' + output + ']'; End; end.