Ran accross this on the QUIK_BAS echo and it compiles and runs no problems
under QuickBasic, tried several modifications and can't seem to get it to
run under PB3.0. This is the original less a few comments. Any help
appreciated. BTW I am new to this echo.
DECLARE SUB CRC32Init () 
DECLARE FUNCTION FileCRC& (FileName$) 
DECLARE FUNCTION QBCRC& (Segment%, Offset%, Length%, CRC&) DEFINT A-Z
CONST LoadBuffer = 8192 'size of disk buffer in FileCRC
DIM SHARED CRCTable&(255)
CLS
CALL CRC32Init
INPUT "File "; FileSpec$
CRC& = FileCRC&(FileSpec$)
PRINT STRING$(6, 29); HEX$(CRC&)
'(This table is CCITT-32 compatible.)
DATA &H000000000,&H077073096,&H0EE0E612C,&H0990951BA,&H0076DC419
DATA &H0706AF48F,&H0E963A535,&H09E6495A3,&H00EDB8832,&H079DCB8A4
DATA &H0E0D5E91E,&H097D2D988,&H009B64C2B,&H07EB17CBD,&H0E7B82D07
DATA &H090BF1D91,&H01DB71064,&H06AB020F2,&H0F3B97148,&H084BE41DE
DATA &H01ADAD47D,&H06DDDE4EB,&H0F4D4B551,&H083D385C7,&H0136C9856
DATA &H0646BA8C0,&H0FD62F97A,&H08A65C9EC,&H014015C4F,&H063066CD9
DATA &H0FA0F3D63,&H08D080DF5,&H03B6E20C8,&H04C69105E,&H0D56041E4
DATA &H0A2677172,&H03C03E4D1,&H04B04D447,&H0D20D85FD,&H0A50AB56B
DATA &H035B5A8FA,&H042B2986C,&H0DBBBC9D6,&H0ACBCF940,&H032D86CE3
DATA &H045DF5C75,&H0DCD60DCF,&H0ABD13D59,&H026D930AC,&H051DE003A
DATA &H0C8D75180,&H0BFD06116,&H021B4F4B5,&H056B3C423,&H0CFBA9599
DATA &H0B8BDA50F,&H02802B89E,&H05F058808,&H0C60CD9B2,&H0B10BE924
DATA &H02F6F7C87,&H058684C11,&H0C1611DAB,&H0B6662D3D,&H076DC4190
DATA &H001DB7106,&H098D220BC,&H0EFD5102A,&H071B18589,&H006B6B51F
DATA &H09FBFE4A5,&H0E8B8D433,&H07807C9A2,&H00F00F934,&H09609A88E
DATA &H0E10E9818,&H07F6A0DBB,&H0086D3D2D,&H091646C97,&H0E6635C01
DATA &H06B6B51F4,&H01C6C6162,&H0856530D8,&H0F262004E,&H06C0695ED
DATA &H01B01A57B,&H08208F4C1,&H0F50FC457,&H065B0D9C6,&H012B7E950
DATA &H08BBEB8EA,&H0FCB9887C,&H062DD1DDF,&H015DA2D49,&H08CD37CF3
DATA &H0FBD44C65,&H04DB26158,&H03AB551CE,&H0A3BC0074,&H0D4BB30E2
DATA &H04ADFA541,&H03DD895D7,&H0A4D1C46D,&H0D3D6F4FB,&H04369E96A
DATA &H0346ED9FC,&H0AD678846,&H0DA60B8D0,&H044042D73,&H033031DE5
DATA &H0AA0A4C5F,&H0DD0D7CC9,&H05005713C,&H0270241AA,&H0BE0B1010
DATA &H0C90C2086,&H05768B525,&H0206F85B3,&H0B966D409,&H0CE61E49F
DATA &H05EDEF90E,&H029D9C998,&H0B0D09822,&H0C7D7A8B4,&H059B33D17
DATA &H02EB40D81,&H0B7BD5C3B,&H0C0BA6CAD,&H0EDB88320,&H09ABFB3B6
DATA &H003B6E20C,&H074B1D29A,&H0EAD54739,&H09DD277AF,&H004DB2615
DATA &H073DC1683,&H0E3630B12,&H094643B84,&H00D6D6A3E,&H07A6A5AA8
DATA &H0E40ECF0B,&H09309FF9D,&H00A00AE27,&H07D079EB1,&H0F00F9344
DATA &H08708A3D2,&H01E01F268,&H06906C2FE,&H0F762575D,&H0806567CB
DATA &H0196C3671,&H06E6B06E7,&H0FED41B76,&H089D32BE0,&H010DA7A5A
DATA &H067DD4ACC,&H0F9B9DF6F,&H08EBEEFF9,&H017B7BE43,&H060B08ED5
DATA &H0D6D6A3E8,&H0A1D1937E,&H038D8C2C4,&H04FDFF252,&H0D1BB67F1
DATA &H0A6BC5767,&H03FB506DD,&H048B2364B,&H0D80D2BDA,&H0AF0A1B4C
DATA &H036034AF6,&H041047A60,&H0DF60EFC3,&H0A867DF55,&H0316E8EEF
DATA &H04669BE79,&H0CB61B38C,&H0BC66831A,&H0256FD2A0,&H05268E236
DATA &H0CC0C7795,&H0BB0B4703,&H0220216B9,&H05505262F,&H0C5BA3BBE
DATA &H0B2BD0B28,&H02BB45A92,&H05CB36A04,&H0C2D7FFA7,&H0B5D0CF31
DATA &H02CD99E8B,&H05BDEAE1D,&H09B64C2B0,&H0EC63F226,&H0756AA39C
DATA &H0026D930A,&H09C0906A9,&H0EB0E363F,&H072076785,&H005005713
DATA &H095BF4A82,&H0E2B87A14,&H07BB12BAE,&H00CB61B38,&H092D28E9B
DATA &H0E5D5BE0D,&H07CDCEFB7,&H00BDBDF21,&H086D3D2D4,&H0F1D4E242
DATA &H068DDB3F8,&H01FDA836E,&H081BE16CD,&H0F6B9265B,&H06FB077E1
DATA &H018B74777,&H088085AE6,&H0FF0F6A70,&H066063BCA,&H011010B5C
DATA &H08F659EFF,&H0F862AE69,&H0616BFFD3,&H0166CCF45,&H0A00AE278
DATA &H0D70DD2EE,&H04E048354,&H03903B3C2,&H0A7672661,&H0D06016F7
DATA &H04969474D,&H03E6E77DB,&H0AED16A4A,&H0D9D65ADC,&H040DF0B66
DATA &H037D83BF0,&H0A9BCAE53,&H0DEBB9EC5,&H047B2CF7F,&H030B5FFE9
DATA &H0BDBDF21C,&H0CABAC28A,&H053B39330,&H024B4A3A6,&H0BAD03605
DATA &H0CDD70693,&H054DE5729,&H023D967BF,&H0B3667A2E,&H0C4614AB8
DATA &H05D681B02,&H02A6F2B94,&H0B40BBE37,&H0C30C8EA1,&H05A05DF1B
DATA &H02D02EF8D
SUB CRC32Init
   FOR A = 0 TO 255
      READ CRCTable&(A)
   NEXT
END SUB
'Finds a PKZIP compatible CRC of any size file.
'There isn't any error checking in this example program- that's up to you.
FUNCTION FileCRC& (FileName$)
    handle = FREEFILE                          'get free file handle
    OPEN FileName$ FOR INPUT AS handle: CLOSE  'check to see if it's there
    OPEN FileName$ FOR BINARY AS handle        'open file in binary mode
    B$ = SPACE$(LoadBuffer)                    'allocate space for buffer
    CRC& = &HFFFFFFFF                          'init CRC
    FOR A = 1 TO LOF(handle) \ LoadBuffer      'do the blocks
        GET handle, , B$                       'get block
        CRC& = QBCRC(VARSEG(B$), SADD(B$), LoadBuffer, CRC&)
    NEXT
    whatsleft = LOF(handle) MOD LoadBuffer     'do the oddballs now
    B$ = SPACE$(whatsleft)                     'whatever's left over
    GET handle, , B$                           'get it
    CRC& = QBCRC(VARSEG(B$), SADD(B$), whatsleft, CRC&)
    CLOSE handle                               'close file
    FileCRC& = NOT CRC&                        'return CRC to caller
END FUNCTION
'Uses in-line coding to find a CRC-32 of a block of memory
'Although the "Length" variable is a signed integer, memory blocks >32k
'may be processed by this routine. (To process a block of memory 65535
'bytes long, -1, or &HFFFF, would be passed to this procedure, for
'instance.)
'
FUNCTION QBCRC& (Segment, Offset, Length, CRC&)
'switch to input segment
DEF SEG = Segment
'Since we're going to calculate the CRC 4 bytes at a time, this FOR/NEXT
'takes care of all the oddballs left over...
FOR A = 1 TO Length AND 3
    'Using CINT(CRC&) AND 255 instead of CRC& AND 255 improves speed
    'but it will only work when compiled without range checking
    CRC& = CRCTable&((CLNG(CRC&) AND 255) XOR PEEK(Offset)) XOR (((CRC& AND
&HFFFFFF00) \ 256) AND &HFFFFFF)     Offset = Offset + 1
NEXT
'Adjust length- divide it by 4 using unsigned division
Length = ((Length AND &HFFFC) \ 4) AND &H3FFF
'Drop into loop
GOTO B
'Updates the CRC on the next 4 bytes, doing this 4 bytes at a time
'results in a small improvement in speed, since the compiled code
'will jump less often...
A:  CRC& = CRCTable&((CLNG(CRC&) AND 255) XOR PEEK(Offset)) XOR (((CRC& AND
&HFFFFFF00) \ 256) AND &HFFFFFF)     CRC& = CRCTable&((CLNG(CRC&) AND 255)
XOR PEEK(Offset + 1)) XOR (((CRC& AND &HFFFFFF00) \ 256) AND &HFFFFFF)    
CRC& = CRCTable&((CLNG(CRC&) AND 255) XOR PEEK(Offset + 2)) XOR (((CRC& AND
&HFFFFFF00) \ 256) AND &HFFFFFF)     CRC& = CRCTable&((CLNG(CRC&) AND 255)
XOR PEEK(Offset + 3)) XOR (((CRC& AND &HFFFFFF00) \ 256) AND &HFFFFFF)    
Offset = Offset + 4             '4 bytes over now     Length = Length - 1    
        '1 less byte B:  IF Length  0 THEN GOTO A      'if more bytes then
go 'All done
    QBCRC& = CRC&
END FUNCTION
--- VFIDO 7.00.05
---------------