QB / QB64 Discussion Forum      Other Subforums, Links and Downloads      Archived Pascal Resources    Search

Respond to this messageReturn to Index
Original Message
  • QBASIC example
    • (Login MCalkins)
      Moderator
      Posted Dec 18, 2007 12:12 AM

      the parent post contains the nasm source.
      This has been minimally tested.



      CONST version = "12-18-2007 (MCalkins)"
      DEFINT A-Z
      DECLARE SUB license ()
      DECLARE SUB initsha1 ()

      TYPE sha1t
      messblock AS STRING * 64
      hashstate0 AS LONG
      hashstate1 AS LONG
      hashstate2 AS LONG
      hashstate3 AS LONG
      hashstate4 AS LONG
      bytesrem AS LONG
      totalbytes AS LONG
      code AS STRING * 908
      installed AS INTEGER
      END TYPE
      DIM SHARED sha1 AS sha1t

      CONST schedoffset = &H0
      CONST aoffset = &H140
      CONST boffset = &H144
      CONST coffset = &H148
      CONST doffset = &H14C
      CONST eoffset = &H150
      CONST doitoffset = &H154
      CONST shortoffset = &H17D
      CONST doubleoffset = &H19A
      CONST commonoffset = &H1BC
      CONST hashoffset = &H1E9
      CONST resetstateoffset = &H35E

      initsha1
      IF sha1.installed <> -1 THEN SYSTEM

      DIM byte AS STRING * 1
      PRINT
      PRINT "Version: "; version
      PRINT "Warning: no guarentees are given regarding this program, the accuracy of its"
      PRINT "results, or the effect on the file being processed."
      PRINT "To see license, enter an empty string."
      LINE INPUT "File: "; f$
      IF f$ = "" THEN license: SYSTEM
      OPEN f$ FOR INPUT AS 1: CLOSE
      OPEN f$ FOR BINARY AS 1
      sha1.totalbytes = LOF(1)
      sha1.bytesrem = sha1.totalbytes
      DEF SEG = VARSEG(sha1.code)
      CALL absolute((CLNG(VARPTR(sha1.code)) + resetstateoffset))
      DO
      SELECT CASE sha1.bytesrem
      CASE IS >= 64: GET 1, , sha1.messblock
      CASE 1 TO 63
      FOR i = 1 TO sha1.bytesrem
      GET 1, , byte
      MID$(sha1.messblock, i, 1) = byte
      NEXT i
      END SELECT
      CALL absolute((CLNG(VARPTR(sha1.code)) + doitoffset))
      LOOP WHILE sha1.bytesrem
      CLOSE
      t$ = MKL$(sha1.hashstate4) + MKL$(sha1.hashstate3) + MKL$(sha1.hashstate2) + MKL$(sha1.hashstate1) + MKL$(sha1.hashstate0)
      a$ = ""
      FOR i = LEN(t$) - 1 TO 0 STEP -1
      a$ = a$ + RIGHT$("0" + HEX$(ASC(MID$(t$, i + 1, 1))), 2)
      NEXT i
      a$ = LCASE$(a$)
      PRINT a$
      PRINT
      SYSTEM

      DEFSNG A-Z
      SUB initsha1
      t$ = STRING$(&H140, &H0)
      t$ = t$ + MKL$(&H0)
      t$ = t$ + MKL$(&H0)
      t$ = t$ + MKL$(&H0)
      t$ = t$ + MKL$(&H0)
      t$ = t$ + MKL$(&H0)
      t$ = t$ + CHR$(&H6)
      t$ = t$ + MKI$(&HDA8C)
      t$ = t$ + MKI$(&HC28E)
      t$ = t$ + CHR$(&HFC)
      t$ = t$ + MKI$(&HA166) + MKI$(VARPTR(sha1.bytesrem))
      t$ = t$ + MKL$(&H403D66) + MKI$(&H0)
      t$ = t$ + MKI$(&H1772)
      t$ = t$ + MKI$(&H80E8) + CHR$(&H0)
      t$ = t$ + MKI$(&H8166) + CHR$(&H2E) + MKI$(VARPTR(sha1.bytesrem)) + MKL$(&H40)
      t$ = t$ + MKI$(&HA166) + MKI$(VARPTR(sha1.bytesrem))
      t$ = t$ + MKI$(&H8566) + CHR$(&HC0)
      t$ = t$ + MKI$(&H274)
      t$ = t$ + CHR$(&H7)
      t$ = t$ + CHR$(&HCB)
      t$ = t$ + MKL$(&H383D66) + MKI$(&H0)
      t$ = t$ + MKI$(&H1573)
      t$ = t$ + MKI$(&HC789)
      t$ = t$ + MKI$(&HC781) + MKI$(VARPTR(sha1.messblock))
      t$ = t$ + MKI$(&H5C6) + CHR$(&H80)
      t$ = t$ + CHR$(&H47)
      t$ = t$ + MKI$(&HC030)
      t$ = t$ + CHR$(&HB9) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.messblock)) + &H3C)))
      t$ = t$ + MKI$(&HF929)
      t$ = t$ + MKI$(&HAAF3)
      t$ = t$ + MKI$(&H22EB)
      t$ = t$ + MKI$(&HC789)
      t$ = t$ + MKI$(&HC781) + MKI$(VARPTR(sha1.messblock))
      t$ = t$ + MKI$(&H5C6) + CHR$(&H80)
      t$ = t$ + CHR$(&H47)
      t$ = t$ + MKI$(&HC030)
      t$ = t$ + CHR$(&HB9) + MKI$(VARPTR(sha1.hashstate0))
      t$ = t$ + MKI$(&HF929)
      t$ = t$ + MKI$(&HAAF3)
      t$ = t$ + MKI$(&H39E8) + CHR$(&H0)
      t$ = t$ + CHR$(&HBF) + MKI$(VARPTR(sha1.messblock))
      t$ = t$ + MKI$(&H3166) + CHR$(&HC0)
      t$ = t$ + MKI$(&HFB9) + CHR$(&H0)
      t$ = t$ + MKI$(&H66F3) + CHR$(&HAB)
      t$ = t$ + MKI$(&HA166) + MKI$(VARPTR(sha1.totalbytes))
      t$ = t$ + MKL$(&H3E0C166)
      t$ = t$ + MKI$(&H4588) + CHR$(&H3)
      t$ = t$ + MKL$(&H8E8C166)
      t$ = t$ + MKI$(&H4588) + CHR$(&H2)
      t$ = t$ + MKL$(&H8E8C166)
      t$ = t$ + MKI$(&H4588) + CHR$(&H1)
      t$ = t$ + MKL$(&H8E8C166)
      t$ = t$ + MKI$(&H588)
      t$ = t$ + MKI$(&HBE8) + CHR$(&H0)
      t$ = t$ + MKI$(&HC766) + CHR$(&H6) + MKI$(VARPTR(sha1.bytesrem)) + MKL$(&H0)
      t$ = t$ + CHR$(&H7)
      t$ = t$ + CHR$(&HCB)
      t$ = t$ + CHR$(&HBE) + MKI$(VARPTR(sha1.messblock))
      t$ = t$ + CHR$(&HBF) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset)))
      t$ = t$ + MKI$(&H10B9) + CHR$(&H0)
      t$ = t$ + CHR$(&HAC)
      t$ = t$ + MKL$(&H8E0C166)
      t$ = t$ + CHR$(&HAC)
      t$ = t$ + MKL$(&H8E0C166)
      t$ = t$ + CHR$(&HAC)
      t$ = t$ + MKL$(&H8E0C166)
      t$ = t$ + CHR$(&HAC)
      t$ = t$ + MKI$(&HAB66)
      t$ = t$ + MKI$(&HECE2)
      t$ = t$ + MKL$(&HF4458B66)
      t$ = t$ + MKL$(&HE0453366)
      t$ = t$ + MKL$(&HC8453366)
      t$ = t$ + MKL$(&HC0453366)
      t$ = t$ + MKI$(&H8966) + CHR$(&HC2)
      t$ = t$ + MKI$(&HD166) + CHR$(&HD0)
      t$ = t$ + MKI$(&H8966) + CHR$(&HD0)
      t$ = t$ + MKI$(&HD166) + CHR$(&HD0)
      t$ = t$ + MKI$(&HAB66)
      t$ = t$ + MKI$(&HFF81) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset + &H13C)))
      t$ = t$ + MKI$(&HDC76)
      t$ = t$ + CHR$(&HBE) + MKI$(VARPTR(sha1.hashstate0))
      t$ = t$ + CHR$(&HBF) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + aoffset)))
      t$ = t$ + MKI$(&H5B9) + CHR$(&H0)
      t$ = t$ + MKI$(&H66F3) + CHR$(&HA5)
      t$ = t$ + CHR$(&HBE) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset)))
      t$ = t$ + MKI$(&HA166) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + aoffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&HC2)
      t$ = t$ + MKL$(&H5E0C166)
      t$ = t$ + MKL$(&H1BEAC166)
      t$ = t$ + MKI$(&H966) + CHR$(&HD0)
      t$ = t$ + MKI$(&H366) + CHR$(&H6) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + eoffset)))
      t$ = t$ + MKI$(&H366) + CHR$(&H4)
      t$ = t$ + MKI$(&HFE81) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset + &H4C)))
      t$ = t$ + MKI$(&H2676)
      t$ = t$ + MKI$(&HFE81) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset + &H9C)))
      t$ = t$ + MKI$(&H4876)
      t$ = t$ + MKI$(&HFE81) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset + &HEC)))
      t$ = t$ + MKI$(&H5C76)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&H3366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H3366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H166) + CHR$(&HD0)
      t$ = t$ + MKL$(&HC1D60566) + MKI$(&HCA62)
      t$ = t$ + MKI$(&H72EB)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&HF766) + CHR$(&HD2)
      t$ = t$ + MKI$(&H2366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&HD1)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&H2366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H3166) + CHR$(&HCA)
      t$ = t$ + MKI$(&H166) + CHR$(&HD0)
      t$ = t$ + MKL$(&H79990566) + MKI$(&H5A82)
      t$ = t$ + MKI$(&H4AEB)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&H3366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H3366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H166) + CHR$(&HD0)
      t$ = t$ + MKL$(&HEBA10566) + MKI$(&H6ED9)
      t$ = t$ + MKI$(&H30EB)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&H2366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&HD1)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&H2366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H3166) + CHR$(&HD1)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H2366) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H3166) + CHR$(&HCA)
      t$ = t$ + MKI$(&H166) + CHR$(&HD0)
      t$ = t$ + MKL$(&HBCDC0566) + MKI$(&H8F1B)
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + eoffset)))
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + doffset)))
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&HD1)
      t$ = t$ + MKL$(&H2EAC166)
      t$ = t$ + MKL$(&H1EE1C166)
      t$ = t$ + MKI$(&H966) + CHR$(&HCA)
      t$ = t$ + MKI$(&H8966) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + coffset)))
      t$ = t$ + MKI$(&H8B66) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + aoffset)))
      t$ = t$ + MKI$(&H8966) + CHR$(&H16) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + boffset)))
      t$ = t$ + MKI$(&HA366) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + aoffset)))
      t$ = t$ + MKL$(&H4C681)
      t$ = t$ + MKI$(&HFE81) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + schedoffset + &H13C)))
      t$ = t$ + MKL$(&HFF02860F)
      t$ = t$ + CHR$(&HBE) + MKI$(VAL("&h" + HEX$(CLNG(VARPTR(sha1.code)) + aoffset)))
      t$ = t$ + MKI$(&HAD66)
      t$ = t$ + MKI$(&H166) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate0))
      t$ = t$ + MKI$(&HAD66)
      t$ = t$ + MKI$(&H166) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate1))
      t$ = t$ + MKI$(&HAD66)
      t$ = t$ + MKI$(&H166) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate2))
      t$ = t$ + MKI$(&HAD66)
      t$ = t$ + MKI$(&H166) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate3))
      t$ = t$ + MKI$(&HAD66)
      t$ = t$ + MKI$(&H166) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate4))
      t$ = t$ + CHR$(&HC3)
      t$ = t$ + MKI$(&HC766) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate0)) + MKL$(&H67452301)
      t$ = t$ + MKI$(&HC766) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate1)) + MKL$(&HEFCDAB89)
      t$ = t$ + MKI$(&HC766) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate2)) + MKL$(&H98BADCFE)
      t$ = t$ + MKI$(&HC766) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate3)) + MKL$(&H10325476)
      t$ = t$ + MKI$(&HC766) + CHR$(&H6) + MKI$(VARPTR(sha1.hashstate4)) + MKL$(&HC3D2E1F0)
      t$ = t$ + CHR$(&HCB)

      IF LEN(t$) <> LEN(sha1.code) THEN PRINT "Error!": SYSTEM
      sha1.code = t$: sha1.installed = -1
      END SUB

      DEFINT A-Z
      SUB license
      CLS
      PRINT "Copyright (c) 2007 Michael Calkins <qbasicmichael"; "@";
      PRINT "gmail."; "com>"
      PRINT
      PRINT "Permission is hereby granted, free of charge, to any person obtaining a copy of"
      PRINT "this software and associated documentation files (the "; CHR$(&H22); "Software"; CHR$(&H22); "), to deal in"
      PRINT "the Software without restriction, including without limitation the rights to"
      PRINT "use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies"
      PRINT "of the Software, and to permit persons to whom the Software is furnished to do"
      PRINT "so, subject to the following conditions:"
      PRINT
      PRINT "The above copyright notice and this permission notice shall be included in all"
      PRINT "copies or substantial portions of the Software."
      PRINT
      PRINT "THE SOFTWARE IS PROVIDED "; CHR$(&H22); "AS IS"; CHR$(&H22); ", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR"
      PRINT "IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,"
      PRINT "FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE"
      PRINT "AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER"
      PRINT "LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,"
      PRINT "OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE"
      PRINT "SOFTWARE."
      END SUB
    Your Name
    Message Title
    Message Text
    Options
          


     Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement