Skip to content

Instantly share code, notes, and snippets.

@7shi 7shi/ConvSch.fsx
Last active Aug 29, 2015

Embed
What would you like to do?
[F#]Schedule Board (http://www.rumix.com/sb/) のファイルを変換・修復
// This file is in the public domain.
#r "System"
#r "System.Drawing"
#r "System.Windows.Forms"
open System
open System.IO
open System.Text
open System.Drawing
open System.Windows.Forms
type ExOpt<'a> = ExSome of 'a | ExErr of int
type MaybeErrorBuilder() =
member this.Bind(x: int * bool, f) =
if snd x then f() else ExErr (fst x)
member this.Return(x) = ExSome x
let maybeError = MaybeErrorBuilder()
let readstr (br:BinaryReader) =
let len = int <| br.ReadByte()
if len = 0 then "" else
let len = if len < 255 then len else int <| br.ReadUInt16()
br.ReadBytes len |> Encoding.Default.GetString
let writestr (bw:BinaryWriter) (s:string) =
let b = Encoding.Default.GetBytes s
if b.Length = 0 then
bw.Write 0uy
elif b.Length < 255 then
bw.Write (byte b.Length)
bw.Write b
else
bw.Write 255uy
bw.Write (uint16 b.Length)
bw.Write b
type Record() =
member val Type = 0 with get, set
member val Start = 0L with get, set
member val End = 0L with get, set
member val Modify = 0L with get, set
member val Color = 0 with get, set
member val Index = 0 with get, set
member val Text = "" with get, set
member val Id = "" with get, set
member val User = "" with get, set
member val Desc = "" with get, set
member r.Write(bw:BinaryWriter) =
bw.Write 0x12c
bw.Write 0x50002
bw.Write r.Type // 0:新規, 1:修正, 2:削除
bw.Write 0
bw.Write r.Start
bw.Write 0
bw.Write r.End
bw.Write 0
bw.Write r.Modify
bw.Write r.Color
bw.Write r.Index
writestr bw r.Text
writestr bw r.Id
writestr bw r.User
writestr bw r.Desc
bw.Write 0uy
override r.ToString() =
sprintf "%d,%d,%d,%d,%d,%d,%d,%d,%d,\"%s\",\"%s\",\"%s\",\"%s\""
r.Type
(r.Start |> int) (r.Start >>> 32 |> int)
(r.End |> int) (r.End >>> 32 |> int)
(r.Modify |> int) (r.Modify >>> 32 |> int)
r.Color r.Index r.Text r.Id r.User r.Desc
member r.Contains (rr:Record) =
rr.Type = 0 && r.Id = rr.Id &&
((r.Start <= rr.Start && rr.Start < r.End) ||
(r.Start < rr.End && rr.End <= r.End))
let readrec (br:BinaryReader) = maybeError {
let r = Record()
do! 1, br.ReadInt32() = 0x12c
do! 2, br.ReadInt32() = 0x50002
r.Type <- br.ReadInt32()
do! 3, br.ReadInt32() = 0
r.Start <- br.ReadInt64()
do! 4, br.ReadInt32() = 0
r.End <- br.ReadInt64()
do! 5, br.ReadInt32() = 0
r.Modify <- br.ReadInt64()
r.Color <- br.ReadInt32()
r.Index <- br.ReadInt32()
r.Text <- readstr br
r.Id <- readstr br
r.User <- readstr br
r.Desc <- readstr br
do! 6, br.ReadByte() = 0uy
return r }
let readsch f =
use br = new BinaryReader(new FileStream(f, FileMode.Open))
let ret = new System.Collections.Generic.List<Record>()
let rec loop() =
if br.PeekChar() = -1 then 0, 0L else
let pos = br.BaseStream.Position
match readrec br with
| ExErr e ->
e, pos
| ExSome r ->
ret.Add r
loop()
match loop() with a, b -> a, b, ret.ToArray()
let writecsv (tw:TextWriter) (recs:Record[]) =
recs |> Array.iteri (fun num r -> tw.WriteLine("{0},{1}", num, r))
let rebuild (recs:Record[]) =
let recs = Array.copy recs
for r in recs do
match r.Type with
| 1 ->
recs.[r.Index].Type <- 3
r.Type <- 0
r.Index <- 0
| 2 ->
recs.[r.Index].Type <- 3
| _ ->
()
recs |> Array.iteri (fun i r ->
if r.Type = 0 && recs.[i + 1 ..] |> Array.exists r.Contains then
r.Type <- 4)
recs |> Array.filter (fun r -> r.Type = 0)
let suffix f sfx =
let dir = Path.GetDirectoryName f
let name = Path.GetFileNameWithoutExtension f
let ext = Path.GetExtension f
Path.Combine(dir, name + sfx + ext)
let convert f =
let e, pos, recs = readsch f
let fout = Path.ChangeExtension(f, ".csv")
use sw = new StreamWriter(fout, false, Encoding.Default)
writecsv sw recs
if e <> 0 then fprintfn sw "error,%d,%x" e pos
use sw2 = new StreamWriter(suffix fout "-2", false, Encoding.Default)
let recs2 = rebuild recs
writecsv sw2 recs2
use bw = new BinaryWriter(new FileStream(suffix f "-2", FileMode.Create))
for r in recs2 do r.Write bw
[<EntryPoint; STAThread>] do
let w = new Form(Text = "SCH 変換修復", AllowDrop = true)
w.Controls.Add (new Label(Text = "ここに .sch ファイルを DnD してください。",
Dock = DockStyle.Fill,
TextAlign = ContentAlignment.MiddleCenter))
w.DragEnter.Add <| fun e ->
if e.Data.GetDataPresent DataFormats.FileDrop then
e.Effect <- DragDropEffects.Link
w.DragDrop.Add <| fun e ->
let files = e.Data.GetData(DataFormats.FileDrop) :?> string[]
if files <> null then
files
|> Array.filter (fun f -> Path.GetExtension(f).ToLower() = ".sch")
|> Array.iter convert
Application.Run w
Attribute VB_Name = "csv2sch"
Option Explicit
Sub WriteStr(T$)
Dim L%, LB As Byte, Buf() As Byte
Buf = StrConv(T, vbFromUnicode)
L = UBound(Buf) + 1
If L = 0 Then
LB = 0
Put #1, , LB
ElseIf L < 255 Then
LB = L
Put #1, , LB
Put #1, , Buf
Else
LB = 255
Put #1, , LB
Put #1, , L
Put #1, , Buf
End If
End Sub
Sub SCH生成()
Dim TMP&, TB As Byte, T&, S1&, S2&, E1&, E2&, M1&, M2&, C&, I&, Tx$, Id$, Us$, Ds$, Y%
Y = 1
Open "C:\output.sch" For Binary Lock Write As #1
While Cells(Y, 1) <> ""
T = Cells(Y, 2)
S1 = Cells(Y, 3)
S2 = Cells(Y, 4)
E1 = Cells(Y, 5)
E2 = Cells(Y, 6)
M1 = Cells(Y, 7)
M2 = Cells(Y, 8)
C = Cells(Y, 9)
I = Cells(Y, 10)
Tx = Cells(Y, 11)
Id = Cells(Y, 12)
Us = Cells(Y, 13)
Ds = Cells(Y, 14)
TMP = &H12C: Put #1, , TMP
TMP = &H50002: Put #1, , TMP
Put #1, , T
TMP = 0: Put #1, , TMP
Put #1, , S1
Put #1, , S2
TMP = 0: Put #1, , TMP
Put #1, , E1
Put #1, , E2
TMP = 0: Put #1, , TMP
Put #1, , M1
Put #1, , M2
Put #1, , C
Put #1, , I
WriteStr Tx
WriteStr Id
WriteStr Us
WriteStr Ds
TB = 0: Put #1, , TB
Y = Y + 1
Wend
Close #1
End Sub
"C:\Program Files\Microsoft SDKs\F#\3.0\Framework\v4.0\fsc" --standalone --target:winexe ConvSch.fsx
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.